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)
マクロVBAで、オートシェイプ(図形)を扱う場合の解説です。オートシェイプ(図形)はShapeオブジェクトであり、ShapeオブジェクトのコレクションがShapesコレクションになります。Shapeオブジェクトは、多くのオブジェクトをメンバーに持った複雑なオブジェクトとなっています。
オートシェイプを他ブックの同じ位置に貼り付ける(Shapes,DrawingObjects)
コメントでリクエストを頂きました。「1つのシートにバラバラにあるオートシェープを一度に選択して、コピーし、ほかのブックのあるシートの同じ位置にペーストしたい」というもの。これには色々な問題が含まれています。
図形オートシェイプ(Shape)の複数選択
図形オートシェイプを複数選択するVBAについてのサンプルと簡単な解説です。Shapeオブジェクトは非常に複雑で、簡単な操作でもVBAの書き方が分からない場合も多くあります。Shapeの基本については以下を参照してください。
図形(Shape)関連のプロパティ、メソッド一覧
図形(Shape)を構成するオブジェクトには、以下のものがあります。Shapesコレクション…Shapeオブジェクトのコレクション Shapeオブジェクト…オートシェイプ、OLEオブジェクト、ピクチャなど、描画レイヤーのオブジェクトを表します。




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

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


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

エクセル馬名ダービー|エクセル雑感(2021-07-21)
在庫を減らせ!毎日棚卸ししろ!|エクセル雑感(2021-07-05)
日付型と通貨型のValueとValue2について|エクセル雑感(2021-06-26)
DXってなんだ? ITと何が違うの?|エクセル雑感(2021-06-24)
エクセルVBA 段級位 目安|エクセル雑感(2021-06-21)
ローカル版エクセルが「Office Scripts」に変わる日|エクセル雑感(2021-06-10)
新関数SORTBYをVBAで利用するラップ関数を作成|VBA技術解説(2021-06-12)
VBA今日のひとこと/VBA今日の教訓 on Twitter|エクセル雑感(2021-06-10)
VBAの演算子まとめ(演算子の優先順位)|VBA技術解説(2021-06-09)
画像が行列削除についてこない場合の対処|VBA技術解説(2021-06-04)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.Excelショートカットキー一覧|Excelリファレンス
3.変数宣言のDimとデータ型|VBA入門
4.RangeとCellsの使い方|VBA入門
5.繰り返し処理(For Next)|VBA入門
6.マクロって何?VBAって何?|VBA入門
7.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
8.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
9.セルに文字を入れるとは(Range,Value)|VBA入門
10.とにかく書いてみよう(Sub,End Sub)|VBA入門




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


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



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