VBA練習問題
VBA100本ノック 19本目:図形のコピー

VBAを100本の練習問題で鍛えます
最終更新日:2021-06-26

VBA100本ノック 19本目:図形のコピー


シートの全図形をコピーする問題です。
繰り返し実行しても図形が増殖しないようにします。


ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。


出題

出題ツイートへのリンク

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

マクロ VBA 100本ノック

マクロ VBA 100本ノック


サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_19.xlsm
https://excel-ubara.com/vba100sample/VBA100_19.zip


VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。


他の人の回答および解説を見て、書いたVBAを見直してみましょう。


頂いた回答

解説

シートの全図形はShapes(Shapeのコレクション)に入っています。
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


Duplicateはオブジェクトを返してくれるので便利ですね。
増殖を抑える方法として、Nameの代わりにAlternativeTextを使うような方法も考えられそうです。
AlternativeTextとCopyメソッドを使った場合のVBAサンプルは記事補足に掲載しました。


補足

コピーの増殖を抑える方法について
元の図とコピーした図を判別する為には何らかの規則・制限が必要になります。
いろいろな方法が考えられますが、
・規則・制限による不便さ
・実装の容易さ
これらを天秤にかけることになります。
規則は確実に守られるならどんな規則でも良いのですが、出来れば規則を知らなくても自然と守られるような規則が望ましいですね。
名前に通常使わないような特別な文字列を使う方法は簡易かつかなり確実に守られると思います。
最大の欠点は、これによりコピーされた図を、さらに手動でコピーした時になると思います。
名前もそのままコピーされてしまうので、これは判別できなくなります。

CopyメソッドとDuplicateメソッド
ShapeのCopyメソッドは戻り値がなく、コピーされた図形が選択状態になります。
対して、Duplicateメソッドは複製してオブジェクトが返されます。
したがって、Duplicateを使うと図形を複製した後のオブジェクトが簡単に指定できるところが便利です。

入力規則のドロップダウンについて
入力規則のドロップダウンは、シートを開いて一度も使っていないとShapesに入っていないのですが、
セルを選択して、▽を表示した時点でShapesに入ってきます。
そもそもフォームコントロールを共通に扱うのは難しいので、これを除外しました。
ActiveXコントロールも併せて除外しています。

ShapeのType
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 テキスト効果

CopyメソッドとAlternativeTextを使ったサンプル
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を使ってもよいでしょう。

ただし上記VBAのとおり、CopyおよびPasteでは、一定時間の待ちを設ける必要があります。
待ちを入れなくても上手く動作する場合もありますが、かなりの確率でエラーになってしまいます。
Shapeの数が多い場合は処理時間がとてもかかってしまいます。

VBA終了時に図形が選択された状態を解除するのに、シートをSelectせずに行う方法としてProtectを利用しています。


サイト内関連ページ

第97回.図形オートシェイプ(Shape)
・図形オートシェイプ(Shape)関連のオブジェクト群 ・図形オートシェイプ(Shape)の追加 ・図形オートシェイプ(Shape)の削除 ・図形オートシェイプ(Shape)の編集 ・図形オートシェイプ(Shape)の全選択 ・図形オートシェイプ(Shape)の扱い方を工夫する ・オートシェイプ(Shape)を扱う実践例 ・図形オートシェイプ(Shape)に関連する記事
オートシェイプを他ブックの同じ位置に貼り付ける(Shapes,DrawingObjects)
コメントでリクエストを頂きました。「1つのシートにバラバラにあるオートシェープを一度に選択して、コピーし、ほかのブックのあるシートの同じ位置にペーストしたい」というもの。これには色々な問題が含まれています。
図形オートシェイプ(Shape)の複数選択
・ワークシートの全てのShapeを選択する場合 ・ShapeオブジェクトのSelectメソッド ・ShapeRangeオブジェクト ・シート内の指定名称の図形を選択
図形(Shape)関連のプロパティ、メソッド一覧
・Shapesコレクション ・・・ Shapeオブジェクトのコレクション ・Shapeオブジェクト ・・・ オートシェイプやピクチャなど、描画レイヤーのオブジェクト ・ShapeRangeオブジェクト ・・・ 文書の図形セットである図形範囲を表します。 ・GroupShapesオブジェクト ・・・ グループ化した図形を表します。 ・FillFormatオブジェクト ・・・ 図形の塗りつぶしの書式設定を表します。 ・LineFormatオブジェクト ・・・ 線と矢印の両端の書式を表します。 ・TextFrameオブジェクト ・・・ レイアウト枠を表します。 ・TextFrame2オブジェクト ・・・ 2007から追加されたTextFrameの後継オブジェクト。




同じテーマ「VBA100本ノック」の記事

16本目:無駄な改行を削除
17本目:重複削除(ユニーク化)
18本目:名前定義の削除
19本目:図形のコピー
20本目:ブックのバックアップ
21本目:バックアップファイルの削除
22本目:FizzBuzz発展問題
23本目:シート構成の一致確認
24本目:全角英数のみ半角
25本目:マトリックス表をDB形式に変換
26本目:ファイル一覧作成


新着記事NEW ・・・新着記事一覧を見る

抜けている数値を探せ|エクセル雑感(2022-07-01)
.Net FrameworkのSystem.Collectionsを利用|VBA技術解説(2022-06-29)
迷路ネコが影分身の術を体得したら…|エクセル雑感(2022-06-27)
迷路にネコが挑戦したら、どうなるかな…|エクセル雑感(2022-06-26)
サロゲートペアに対応した自作関数(Len,Left,Mid,Right)|エクセル雑感(2022-06-24)
「マクロの登録」で登録できないプロシージャーは?|エクセル雑感(2022-06-23)
オブジェクトのByRef、ByVal、Variant|エクセル雑感(2022-06-22)
コメントから特定形式の年月を取り出す|エクセル雑感(2022-06-19)
4,9を使わない連番作成|エクセル雑感(2022-06-17)
連番を折り返して出力|エクセル雑感(2022-06-16)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Excelショートカットキー一覧|Excelリファレンス
7.マクロって何?VBAって何?|VBA入門
8.並べ替え(Sort)|VBA入門
9.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
10.エクセルVBAでのシート指定方法|VBA技術解説




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ