オートシェイプを他ブックの同じ位置に貼り付ける（Shapes,DrawingObjects）
コメントでリクエストを頂きました。
「１つのシートにバラバラにあるオートシェープを一度に選択して、コピーし、
ほかのブックのあるシートの同じ位置にペーストしたい」
というもの。
これには色々な問題が含まれています。
１．マクロの記録に関する問題
２．同じ位置とは・・・行高、列幅が違う場合は
まず、
１．マクロの記録に関する問題
Excel2007では、オートシェイプのSelectが正しく記録されません。
私の環境だけではないですよね、
２台のPCでダメでしたので。
２．同じ位置とは・・・行高、列幅が違う場合は
これは、行列見出しからの位置を同じとするか、
開始セル位置を同じにするかです。
以下では、いろいろな方法を紹介していますので、
いずれか、お好きな方法を選択して下さい。
Book1.xlsのSheet1の図形を全て、Book2.xlsのSheet2へコピーします。
まずは、マクロの記録に近い形でやってみましょう。
Sub ShapeCopy1()
With
Workbooks("Book1.xls")
.Activate
.Worksheets("Sheet1").Select
.Worksheets("Sheet1").Shapes.SelectAll
Selection.Copy
End
With
With Workbooks("Book2.xls")
.Activate
With
.Worksheets("Sheet2")
.Select
.Range("A1").Select
.Paste
End
With
End With
End Sub
Shapes.SelectAll
これで、そのシートの全図形を選択できます。
Withを多用していて、少しわかりずらかったかもしれません。
まあ、普通にコピーし、普通に貼り付けしているだけです。
ただし、これでは、違う位置に貼り付けられます。
上のマクロをもっと簡単に記述すると、以下になります。
Sub
ShapeCopy2()
Workbooks("Book1.xls").Worksheets("Sheet1").DrawingObjects.Copy
Workbooks("Book2.xls").Worksheets("Sheet2").Paste
End
Sub
注意点は、
DrawingObjects.Copy
ここですね。
Shapesでは、.Copyが使えません。
Shapesは、DrawingObjectsなのです。
最初のマクロ同様、違う位置に貼り付けられますね。
そこで、貼り付け位置を、Book1.xlsのSheet1より取得します。
Sub ShapeCopy3()
Dim myShape As Variant
Dim rowMin As Long, colMin
As Long
rowMin = Rows.Count
colMin = Columns.Count
For Each
myShape In Workbooks("Book1.xls").Worksheets("Sheet1").Shapes
If rowMin
> myShape.TopLeftCell.Row Then
rowMin =
myShape.TopLeftCell.Row
End If
If colMin >
myShape.TopLeftCell.Column Then
colMin =
myShape.TopLeftCell.Column
End
If
Next
Workbooks("Book1.xls").Worksheets("Sheet1").DrawingObjects.Copy
With
Workbooks("Book2.xls")
.Activate
With
.Worksheets("Sheet2")
.Select
.Cells(rowMin,
colMin).Select
.Paste
End With
End With
End
Sub
全ての図形について、左上のセルを取得し、
最も左と、最も上の位置を取得します。
そして、その位置に一括で張り付けています。
これで、ほぼ良さそうですが、行高、列幅が違う場合は、
見た目の位置は、違った位置に張り付いてしまいます。
では、行列の見出しからの位置を同じにする為に、
コピー後に、位置をずらしてみましょう。
Sub ShapeCopy4()
Dim obj As Object
With
Workbooks("Book1.xls")
.Activate
.Worksheets("Sheet1").Select
.Worksheets("Sheet1").Shapes.SelectAll
Selection.Ungroup
Set
obj = Selection.Group
obj.Copy
End With
With
Workbooks("Book2.xls")
.Activate
With
.Worksheets("Sheet2")
.Select
.Cells(1,
1).Select
.Paste
Selection.Top = obj.Top
Selection.Left = obj.Left
Selection.Ungroup
End
With
End With
obj.Ungroup
End Sub
一つずつやるのは面倒なので、一旦グループ化しています。
そして、グループごとコピー貼り付け後に、位置をずらしています。
元々、いくつかのグループを作成している場合は都合が悪いです。
そこで、一つずつコピーしてみましょう。
当初のリクエストでは一括でとありましたが、
別にコピー事態が一括である必要はないでしょう。
Sub ShapeCopy5()
Dim myShape As
Variant
Workbooks("Book2.xls").Activate
Worksheets("Sheet2").Select
For
Each myShape In
Workbooks("Book1.xls").Worksheets("Sheet1").Shapes
myShape.Copy
ActiveSheet.Paste
Selection.Top
= myShape.Top
Selection.Left = myShape.Left
Next
End
Sub
正直なところ、これが一番良いと思いますね。
私が、単純に作成するとしたら、このようなマクロになると思います。
これなら、オートシェイプを取捨選択できますし、
３番目のマクロのように、
myShape.TopLeftCell
を使用すれば、同じセル位置にも貼り付けが可能です。
処理スピード等の問題がなければ、
オブシェクトは、For Eachで１つずつ処理するのが最も汎用性が高くなります。
いかがでしたでしょうか。
なお、エラー処理は入れていませんので、図形が無い場合等の対処は適時入れて下さい。
また、図形の選択状態を解除していませんので、セルの選択等も適時入れて下さい。
ぱっと読むと簡単そうに見える処理も、いろいろな条件を考えると、結構難しい面があります。
質問者様は、ネットで良いコードが見つからなかったとありましたが、
上記の全てのマクロを理解できるように説明しているサイトは無いと思います。
このようなリクエストは大歓迎です。
同じテーマ「マクロVBAサンプル集」の記事
コメントの位置移動と自動サイズ調整とフォント設定
図をセル内に強制的に収める（Shape）
図を確認しながら消していく（Shape）
オートシェイプを他ブックの同じ位置に貼り付ける（Shapes,DrawingObjects）
全シートの画面キャプチャを取得する（keybd_event）
写真の取込方法について（Pictures.Insert,Shapes.AddPicture）
写真をサムネイルに変換して取り込む（Shapes.AddPicture）
円グラフの色設定（Chart,SeriesCollection）
棒グラフ・折れ線グラフのサンプルマクロ
人口ピラミッドのグラフをマクロで作成
グラフで特定の横軸の色を変更し基準線を引くマクロ
新着記事NEW ・・・新着記事一覧を見る
第5章：AI×VBAでつまづかない！トラブルシューティングとAIとの付き合い方
｜生成AI活用研究(2025-05-20)
第4章：【事例で学ぶ】AIとVBAでExcel作業を劇的に効率化する！
｜生成AI活用研究(2025-05-20)
第3章：AIを「自分だけのVBA先生」にする！質問・相談の超実践テクニック｜生成AI活用研究(2025-05-19)
第2章 VBAって怖くない！Excelを「言葉で動かす」（超入門）｜生成AI活用研究(2025-05-18)
第1章：AIって一体何？あなたのExcel作業をどう変える？（AI超基本）｜生成AI活用研究(2025-05-18)
AI時代のExcel革命：AI×VBAで“書かない自動化”超入門｜生成AI活用研究(2025-05-17)
Geminiと100本ノック 23本目：シート構成の一致確認｜生成AI活用研究（5月16日）
AIが問う出版の未来は淘汰か進化か：AIと書籍の共存の道とは｜生成AI活用研究(2025-05-16)
Geminiと100本ノック 22本目：FizzBuzz発展問題｜生成AI活用研究（5月15日）
すぐに使える！生成AI プロンプト作成 実践ガイド｜生成AI活用研究(2025-05-15)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.繰り返し処理（For Next)｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.ひらがな⇔カタカナの変換｜エクセル基本操作
6.RangeとCellsの使い方｜VBA入門
7.メッセージボックス(MsgBox関数)｜VBA入門
8.セルのクリア（Clear,ClearContents）｜VBA入門
9.FILTER関数（範囲をフィルター処理）｜エクセル入門
10.条件分岐（Select Case）｜VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- オートシェイプを他ブックの同じ位置に貼り付ける（Shapes,DrawingObjects）
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。