【実務直結】Visio VBAで「特定のレイヤーだけ」を別ページに抽出・コピーする極意
「マクロの記録」を使って、なんとか自動化の第一歩を踏み出したあなた。素晴らしい一歩です！
でも、現実に直面していませんか？
*「記録したマクロは、ページ上の全部をコピーしてしまう……」*
*「電気設備レイヤーだけを抜き出して、別の図面ページに移したいのに、壁や家具までついてくる……」*
そう、マクロの記録は「あなたがマウスで何をしたか」をなぞるだけです。「条件によって対象を変える」という、プログラミングの真髄である「ロジック（論理）」を組み込むことはできません。
今日は、マクロの記録という殻を破り、「特定のレイヤーに属するシェイプだけを狙い撃ちしてコピーする」という、実務で最も重宝されるテクニックを伝授します。ここをマスターすれば、Visio VBAの基本はバッチリですよ。
1. コンセプト： 「全選択」から「条件付き選択」へのパラダイムシフト
これまでの「マクロの記録」によるコピーは、おそらくこうでした。
1. `ActivePage.SelectAll`（全部選ぶ）
2. `Selection.Copy`（コピーする）
これでは、不要なものまで付いてきてしまいます。
私たちが目指す「プロの自動化」のロジックは、全く異なります。
理想的なアルゴリズム（手順）
1. ターゲットの特定: コピーしたい「レイヤー名」を決める。
2. 空の選択状態を作る: 一旦、何も選んでいない状態にする。
3. 全シェイプをスキャン: ページ内のシェイプを一つずつ「検問」にかける。
4. レイヤー判定（検問）: 「君は『電気設備』レイヤーに入っているかな？」と聞き、YESなら選択リストに追加する。
5. 実行: 選ばれた精鋭たち（シェイプ）だけをコピー＆ペーストする。
この「一つずつ調べて、条件に合うものだけを集める」という考え方が、プログラミングにおける「ループ（繰り返し）」と「条件分岐」の基本です。
2. 実装コード： レイヤー抽出コピー・マクロ
さあ、実際に動くコードを見てみましょう。初心者の方でも読みやすいよう、丁寧にコメントを添えました。
Sub CopyShapesByLayerName()
' ===========================================================
' 目的: 特定のレイヤーに属するシェイプのみを抽出し、別ページへコピーする
' ===========================================================
Dim srcPage As Visio.Page ' コピー元ページ
Dim destPage As Visio.Page ' コピー先ページ
Dim shp As Visio.Shape ' スキャン中のシェイプ
Dim targetLayerName As String ' 抽出したいレイヤーの名前
Dim sel As Visio.Selection ' 選択状態を保持するオブジェクト
Dim i As Integer ' レイヤー確認用のインデックス
Dim isMatch As Boolean ' レイヤーが一致したかどうかのフラグ
' --- 設定エリア（ここを書き換えて使います） ---
targetLayerName = "電気設備" ' ★抽出したいレイヤー名を正確に指定
' ------------------------------------------
' 1. ページの設定
' 現在表示しているページをコピー元、2ページ目をコピー先とする例
Set srcPage = ActivePage
On Error Resume Next
Set destPage = ActiveDocument.Pages(2) ' 2ページ目が存在しないとエラーになるため注意
On Error GoTo 0
If destPage Is Nothing Then
MsgBox "コピー先のページ（2ページ目）が見つかりません。", vbCritical
Exit Sub
End If
' 2. 選択状態の初期化
' 一旦、現在の選択をすべて解除します（重要！）
Set sel = ActiveWindow.Selection
sel.Clear
' 3. シェイプのスキャン（検問プロセス）
' コピー元ページの全シェイプに対してループ処理を行う
For Each shp In srcPage.Shapes
isMatch = False
' シェイプが複数のレイヤーを持っている可能性があるため、
' そのシェイプが持つ全レイヤーをチェックします
For i = 1 To shp.LayerCount
If shp.Layer(i).Name = targetLayerName Then
isMatch = True
Exit For ' 一致するものが見つかったら、このシェイプの調査は終了
End If
Next i
' 4. 条件に合致した場合、選択リストに追加
If isMatch Then
sel.Add shp
End If
Next shp
' 5. コピー＆ペーストの実行
If sel.Count > 0 Then
' 条件に合うシェイプが見つかった場合
sel.Copy
' コピー先ページへ移動して貼り付け
' ※ActiveWindowを切り替えないと貼り付け先が制御できないため
ActiveWindow.Page = destPage
destPage.Paste
MsgBox targetLayerName & " レイヤーのシェイプをコピーしました。", vbInformation
Else
' 条件に合うシェイプが一つもなかった場合
MsgBox targetLayerName & " レイヤーに属するシェイプは見つかりませんでした。", vbExclamation
End If
End Sub3. アーキテクトの視点： ここが「ハマりどころ」だ！
コードをただコピーするだけでは、一流のエンジニアにはなれません。なぜこの書き方なのか、陥りやすい罠はどこかを理解しましょう。
① `shp.LayerIndex` ではなく `shp.Layer(i).Name` を使う理由
Visioのシェイプは、「複数のレイヤーに同時に所属できる」という特性を持っています。
例えば、「電気設備レイヤー」と「メンテナンス用レイヤー」の両方に所属しているシェイプです。
もし `If shp.LayerIndex = 1` のように番号だけで判定してしまうと、レイヤーの順番が変わった瞬間にマクロが壊れてしまいます。「名前（Name）」で判定するのが、堅牢なコードを書く鉄則です。
② `Selection.Clear` の重要性
もし、マクロを実行する前にユーザーが図面の一部を手動で選択していたらどうなるでしょう？
`sel.Clear` を忘れると、「ユーザーが選んでいたもの ＋ プログラムが選んだもの」が一緒にコピーされてしまいます。自動化ツールは、「常にクリーンな状態から始まる」ことを保証しなければなりません。
③ `ActiveWindow.Page` の切り替え
VBAの世界では、オブジェクト（PageやShape）を操作することと、画面（Window）を操作することは別物です。
`destPage.Paste` と書くだけでは、Visioは「今画面に見えているページ」に貼り付けようとします。確実に指定したページへ貼り付けるには、`ActiveWindow.Page = destPage` を使って、Visioの「視点」を切り替えてあげる必要があります。
4. さらなる高みへ： パフォーマンスを意識する
もし、図面が数千、数万のシェイプを持つ超巨大なものだった場合、`For Each` で一つずつ回す処理は少し重くなるかもしれません。
しかし、初学者の段階では、「正しく動くこと」と「ロジックを理解すること」が最優先です。このコードは、読みやすさと確実性を重視して設計しています。
「何が起きているのか」が手に取るようにわかるコードを書けるようになれば、あなたはもう「マクロの記録」の呪縛から解き放たれています。
まとめ
今回の極意を振り返りましょう。
1. 全選択ではなく、条件に合うものだけを `Selection.Add` で集める。
2. レイヤー判定は、番号ではなく「名前」で行うのが安全。
3. 貼り付けの前には、必ず「視点（ActiveWindow.Page）」を切り替える。
ここをクリアすれば、Visio VBAの基本はバッチリですよ。
次は、コピーした後に「サイズを自動で調整する」なんて処理にも挑戦してみましょう。
応援しています。また次のコードでお会いしましょう！
