Home » エクセルマクロ・Excel VBAの使い方 » Shapesコレクション・Shapeオブジェクト » VBAで図形を同じ位置に複製する

VBAで図形を同じ位置に複製する

動作検証バージョン：64bit Windows 10 Pro + 32bit Excel（バージョン2105 ビルド14026.20270 Microsoft Store）

「EXCEL オートシェイプ Duplicate 同じ場所」
という検索キーワードでアクセスがありました。

（判断に迷うキーワードですが）ここではShapeオブジェクトに用意されているDuplicateメソッドを使って、

Excel.Shape.Duplicate

図形を元の図形と同じ位置に複製するExcel VBAのコードを、ご紹介します。

［スポンサードリンク］

図形を同じ位置に複製するサンプル

以下のようなコードで、図形を元の図形と同じ位置に複製できます。

Sub 図形を同じ位置にDuplicateする()
　Dim shp As Shape, shp2 As Shape
　Set shp = ActiveSheet.Shapes(1)
　Set shp2 = shp.Duplicate

　shp2.Left = shp.Left
　shp2.Top = shp.Top
　
End Sub

図形が1つだけ存在しているワークシートをアクティブな状態で、拙著『いちばんやさしいExcel VBAの教本』で繰り返し行っているようにステップ実行です。その際、ワークシート上の図形をしっかりと観察してください。

図形の複製が行われてから、
　　Set shp2 = shp.Duplicate

左端の位置が、元の図形に揃えられ、
　　shp2.Left = shp.Left

上端の位置が、元の図形に揃えられます。
　　shp2.Top = shp.Top

選択図形を同じ位置に複製するマクロ

実務で使えそうなのが、選択されている図形を元の図形とぴったり重なるように複製するマクロかな、と考えています。

Sub 選択図形を同じ位置にDuplicateする()
On Error GoTo ErrHandl

　Dim shp As Shape, shp2 As Shape
　Set shp = Selection.ShapeRange(1)
　Set shp2 = shp.Duplicate

　shp2.Left = shp.Left
　shp2.Top = shp.Top
　
Exit Sub
ErrHandl:
　MsgBox "図形を選択しておいてから実行してください。"
　Err.Clear
End Sub

レガシーなDrawingObject系オブジェクトに用意されているShapeRangeプロパティの、既定プロパティに「1」を指定することで、選択されている1個の図形を取得している点が、
　　Set shp = Selection.ShapeRange(1)
先ほどのSubプロシージャと異なる点です。

最終更新日時：2021-06-21 22:01

［スポンサードリンク］