19本目：図形のコピー

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：図形のコピー

#VBA100本ノック 19本目
引数でWorksheetを受け取り以下の処理を行うSubを作成してください。
シートの全図形について画像のように元図形の真横にくっ付けてコピー。
繰り返し実行しても増殖しないように工夫する。
※何らかの規則・制限を設けて構いません。
※入力規則のリストに気を付けて。

◇ 出題ページはこちら

ソースコード

Option Explicit

' 100本ノック019：図形のコピー
Sub 指定シートのすべての図形を真横に複製する(ws指定シート As Worksheet)
    
    ' 複製された図形には「【マクロ複製】」を名前に接頭する
    Const Prefix複製図形名 = "【マクロ複製】"
    
    ' 前回実行時の複製図形を削除してから実行
    Dim シェイプ As Shape
    For Each シェイプ In ws指定シート.Shapes
        If シェイプ.Name Like Prefix複製図形名 & "*" Then
            シェイプ.Delete
        End If
    Next
    
    ' シート上のすべての図形をループ
    For Each シェイプ In ws指定シート.Shapes
        If Not シェイプ.Name Like "Drop Down *" Then ' ドロップダウンリストの▼を除外

            ' 図形をコピーして名称と位置を設定
            Dim 複製図形 As Shape
            Set 複製図形 = シェイプ.Duplicate
            複製図形.Name = Prefix複製図形名 & シェイプ.Name
            複製図形.Top = シェイプ.Top
            複製図形.Left = シェイプ.Left + シェイプ.Width

        End If
    Next
    
End Sub

解説

図形を指定の位置へコピーする問題でした。

連続実行で増殖しないという条件なので、
何らかの方法で「マクロによって作成されたもの」を識別する必要があります。

手軽なのは本問で使った「図形名に目印をつける」ことで、
シェイプ.NameをLike演算子で判定するだけで対応できますね。

あとは図形の複製方法ですが、
ShapeのCopyメソッドは「クリップボードにコピー」という処理になります。

別ブックや別シートにコピーするときはそうするより他ないのですが、
同一シート内で複製する場合はDuplicateメソッドが便利です。

これなら解答のように即変数へSetすることが出来ますので、
同シート内でコピーする場合はこちらのメソッドを使用してください。