エクセルVBA100本ノック。１９本目：図形のコピー

この記事から得るもの

１　今回のお題

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

f:id:bimori466:20201112142706p:plain

excel-ubara.com

２　今回のお題の意図

オートシェイプをコピーではなく「複製」で処理する。

３　回答

今回も安定のカンニングです(;^ω^)。最初はお題の意図が分からなかったのですが、調べるうちにわかったことはオートシェイプのコピーと複製は異なることです。

オートシェイプをコピーする場合は、

ActiveSheet.Shapes("丸").Copy
Application.Wait Now() + TimeSerial(0, 0, 1)
ActiveSheet.Paste

単純にコピー、貼付けとなります。
処理待ち時間を入れないとエラーとなることが多いようです。

一方複製は、

ActiveSheet.Shapes("丸").Duplicate

これは、オートシェイプを選択してショートカットキー「Ctrl+D」を押したときの処理となります。
Duplicateの優れて言いる点は、処理待ちの待機時間を持たなくてよいという点です。
また、オブジェクトを返してくれるのでその後の貼り付け先の操作も容易です。

では、ループ処理でオブジェクトを複製しましょう。

Sub ノック19本目_1()
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")

For Each sp In ws.Shapes
    With sp.Duplicate
        .Top = sp.Top
        .Left = sp.Left + sp.Width
    End With
Next
        
End Sub

これで、オートシェイプの複製ができました。

f:id:bimori466:20201112145149p:plain

しかし、今回のお題で「繰り返し実行しても増殖しないように工夫する」とありました。
この条件を満たすためには、オートシェイプに特定の名前を付けます。

Sub ノック19本目_1()で複製したオートシェイプは「丸」「三角」と同じ名前になっています。
そこで、複製した際に固有の文字列を含む名前を付けてあげます。また、処理の最初にオートシェイプの名前に固有の名前を含んでいるオートシェイプは削除するという処理を作ります。

今回の完成版

Sub ノック19本目_Main()

Call ノック19本目_3(Worksheets("Sheet1"))

End Sub

Sub ノック19本目_3(ByVal ws As Worksheet)

'複製されたオートシェイプを削除する処理
For Each sp In ws.Shapes
    If sp.Name Like "*_複製*" Then
        sp.Delete
    End If
Next

'オートシェイプを複製する処理
For Each sp In ws.Shapes
    With sp.Duplicate
        .Name = sp.Name & "_複製"
        .Top = sp.Top
        .Left = sp.Left + sp.Width
    End With
Next
        
End Sub