VBA100本ノック 19本目:図形のコピー
シートの全図形をコピーする問題です。
繰り返し実行しても図形が増殖しないようにします。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
出題
引数でWorksheetを受け取り以下の処理を行うSubを作成してください。
シートの全図形について画像のように元図形の真横にくっ付けてコピー。
繰り返し実行しても増殖しないように工夫する。
※何らかの規則・制限を設けて構いません。
※入力規則のリストに気を付けて。


https://excel-ubara.com/vba100sample/VBA100_19.xlsm
https://excel-ubara.com/vba100sample/VBA100_19.zip
VBA作成タイム
この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。
他の人の回答および解説を見て、書いたVBAを見直してみましょう。
頂いた回答
解説
Shapesには入力規則のドロップダウンも含まれているので対象外にする必要があります。
ShapeをコピーするメソッドはCopyですが、同一シート内の場合はDuplicateが便利です。
複製した図形には特別な名前を付けて判別しています。
Sub VBA100_19_01(ByVal ws As Worksheet)
Dim sp As Shape
For Each sp In ws.Shapes
If sp.Name Like "*【VBA100_19】*" Then
sp.Delete
End If
Next
For Each sp In ws.Shapes
If sp.Type <> msoFormControl And sp.Type <> msoOLEControlObject Then
With sp.Duplicate
.Name = sp.Name & "【VBA100_19】"
.Top = sp.Top
.Left = sp.Left + sp.Width
End With
End If
Next
End Sub
増殖を抑える方法として、Nameの代わりにAlternativeTextを使うような方法も考えられそうです。
AlternativeTextとCopyメソッドを使った場合のVBAサンプルは記事補足に掲載しました。
補足
いろいろな方法が考えられますが、
・規則・制限による不便さ
・実装の容易さ
これらを天秤にかけることになります。
規則は確実に守られるならどんな規則でも良いのですが、出来れば規則を知らなくても自然と守られるような規則が望ましいですね。
名前に通常使わないような特別な文字列を使う方法は簡易かつかなり確実に守られると思います。
最大の欠点は、これによりコピーされた図を、さらに手動でコピーした時になると思います。
名前もそのままコピーされてしまうので、これは判別できなくなります。
対して、Duplicateメソッドは複製してオブジェクトが返されます。
したがって、Duplicateを使うと図形を複製した後のオブジェクトが簡単に指定できるところが便利です。
セルを選択して、▽を表示した時点でShapesに入ってきます。
そもそもフォームコントロールを共通に扱うのは難しいので、これを除外しました。
ActiveXコントロールも併せて除外しています。
MsoShapeType列挙 | 値 | 説明 |
msoAutoShape | 1 | オートシェイプ |
msoCallout | 2 | 引き出し線 |
msoCanvas | 20 | キャンバス |
msoChart | 3 | グラフ |
msoComment | 4 | コメント |
msoDiagram | 21 | ダイアグラム |
msoEmbeddedOLEObject | 7 | 埋め込み OLE オブジェクト |
msoFormControl | 8 | フォーム コントロール |
msoFreeform | 5 | フリーフォーム |
msoGroup | 6 | グループ |
msoIgxGraphic | 24 | SmartArt グラフィック |
msoInk | 22 | インク |
msoInkComment | 23 | インク コメント |
msoLine | 9 | 直線 |
msoLinkedOLEObject | 10 | リンク OLE オブジェクト |
msoLinkedPicture | 11 | リンク画像 |
msoMedia | 16 | メディア |
msoOLEControlObject | 12 | OLE コントロール オブジェクト |
msoPicture | 13 | 画像 |
msoPlaceholder | 14 | プレースホルダー |
msoScriptAnchor | 18 | スクリプト アンカー |
msoShapeTypeMixed | -2 | 図形の種類の組み合わせ |
msoTable | 19 | テーブル |
msoTextBox | 17 | テキスト ボックス |
msoTextEffect | 15 | テキスト効果 |
Sub VBA100_19_02(ByVal ws As Worksheet)
Dim sp As Shape
For Each sp In ws.Shapes
If sp.AlternativeText Like "*【VBA100_19】*" Then
sp.Delete
End If
Next
For Each sp In ws.Shapes
If sp.Type <> msoFormControl And sp.Type <> msoOLEControlObject Then
sp.Copy
Application.Wait Now() + TimeSerial(0, 0, 1)
ws.Paste
Application.Wait Now() + TimeSerial(0, 0, 1)
With ws.Shapes(ws.Shapes.Count)
.AlternativeText = sp.AlternativeText & vbCrLf & "【VBA100_19】"
.Top = sp.Top
.Left = sp.Left + sp.Width
End With
End If
Next
ws.Protect
ws.Unprotect
End Sub
複製した図形の判定にAlternativeTextを使用しています。
Copyメソッドを使用しているので、コピー後のオブジェクトを特定するためにコピーされた図形はコレクションの最後に入ることを利用しています。
これは、Selectionを使ってもよいでしょう。
待ちを入れなくても上手く動作する場合もありますが、かなりの確率でエラーになってしまいます。
Shapeの数が多い場合は処理時間がとてもかかってしまいます。
サイト内関連ページ
同じテーマ「VBA100本ノック」の記事
16本目:無駄な改行を削除
17本目:重複削除(ユニーク化)
18本目:名前定義の削除
19本目:図形のコピー
20本目:ブックのバックアップ
21本目:バックアップファイルの削除
22本目:FizzBuzz発展問題
23本目:シート構成の一致確認
24本目:全角英数のみ半角
25本目:マトリックス表をDB形式に変換
26本目:ファイル一覧作成
新着記事NEW ・・・新着記事一覧を見る
シートコピー後のアクティブシートは何か|ツイッター出題回答 (2023-09-19)
Excel関数の引数を省略した場合について|ツイッター出題回答 (2023-09-14)
セル個数を返すRange.CountLargeプロパティとは|VBA技術解説(2023-09-08)
記号を繰り返してグラフ作成(10単位で折り返す)|ツイッター出題回答 (2023-08-28)
シートを削除:不定数のシート名に対応|VBAサンプル集(2023-08-24)
ランクによりボイントを付ける(同順位はポイントを分割)|ツイッター出題回答 (2023-08-22)
OneDrive使用時のThisWorkbook.Pathの扱い方|VBA技術解説(2023-07-26)
列幅不足による###表示や指数表示を判定する|VBA技術解説(2023-07-12)
シートを削除:不定数のシート名に対応|VBAサンプル集(2023-07-04)
シート関数のCOUNTIFS,SUMIFS,MAXIFSと同じ処理|Power Query(M言語)入門(2023-02-28)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.繰り返し処理(For Next)|VBA入門
4.変数宣言のDimとデータ型|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.マクロとは?VBAとは?VBAでできること|VBA入門
7.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
8.並べ替え(Sort)|VBA入門
9.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
10.条件分岐(IF)|VBA入門
- ホーム
- マクロVBA入門編
- VBA100本ノック
- 19本目:図形のコピー
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。