Visio VBAを掌握する極限の知見：レイヤー整合性チェッカーの実装
図面管理の現場において、もっとも恐ろしい瞬間とは何だろうか。それは、「レイヤーごとに表示・非表示を切り分けて納品すべき最終図面に、未定義の野良シェイプが混入し、クライアントのレビューで致命的な手戻りが発生する」という瞬間だ。
Visioの図面が複雑化するにつれ、設計者はシェイプを乱雑に配置しがちになる。特に複数人で同時並行的に編集した図面では、レイヤー（Layer）の割当ルールが完全に崩壊する。
今回は、手作業による目視チェックを完全に過去のものにする、「ページ内の全シェイプを走査し、未定義レイヤーに属するシェイプを特定して警告する・レイヤー整合性チェッカー」のプロダクションコードを授けよう。
—
1. 現場でありがちな「動かない・遅い」アンチパターン
多くの初学者が書くVisio VBAのコードには、致命的なパフォーマンス上の欠陥がある。特にページ内のシェイプを走査する際、以下のようなコードを書いていないだろうか。
‘ 【悪例】絶対にやってはいけない書き方
Dim shp As Visio.Shape
For Each shp In ActivePage.Shapes
‘ 毎回シェイプのプロパティにアクセスし、かつレイヤーコレクションを都度引く
If shp.CellsU(“LayerMember”).ResultStr(“”) = “” Then
Debug.Print shp.Name
End If
Next shp
このアプローチが実務で破綻する理由は2つある。
1. COMインターフェースのラウンドトリップ地獄: `For Each` による `.Shapes` の走査は、VBAとVisioのC++コアの間で無数のCOMオブジェクト往復が発生し、数千個のシェイプを持つ図面では数分単位で処理がフリーズする。
2. `LayerMember` セルの罠: シェイプが属するレイヤー名は文字列としてセル内に保持されるが、単純な文字列比較だけでは「図形にレイヤーが割り当てられていない状態」と「存在しないレイヤー名が記述されている状態」を正確に判別できず、予期せぬ誤検知を生む。
真のエンジニアリングとは、「メモリ上でスマートにコレクションをキャッシュし、APIの往復コストを最小化すること」に他ならない。
—
2. 堅牢な設計：レイヤー整合性チェッカーのアーキテクチャ
今回構築するツールは、以下のロジックで動作する。
1. 許可されたレイヤー名のホワイトリスト化: 図面定義として存在する有効なレイヤー名（例: `”構造”`, `”電気”`, `”意匠”` など）を事前に配列として保持する。
2. ページ・シェイプの高速走査: `ActivePage.Shapes` を舐める際、グループ化された下位シェイプ（子シェイプ）も漏れなく再帰的に捕捉する（`Recursive` 処理）。
3. 例外レポートの出力: 未定義、あるいはデバッグ用のゴミレイヤーに属するシェイプを発見した場合、そのシェイプのID、名前、所属する不正レイヤー名をイミディエイトウィンドウまたはログシートへ高精度に出力する。
—
3. 【プロダクションコード】レイヤー整合性チェッカー
以下のコードをVisioのVBAエディタ（モジュール）に貼り付けて実行してほしい。実務の巨大な図面でも秒速で動作するよう最適化されている。
Option Explicit
‘ ==============================================================================
‘ 担当者必携：Visio ページ内レイヤー整合性チェッカー
‘ Architecture & Code by 首席自動化エンジニア
‘ ==============================================================================
Public Sub RunLayerIntegrityChecker()
Dim targetPage As Visio.Page
Set targetPage = ActivePage
‘ 1. この図面で許可されている「有効なレイヤー名」の定義（要件に合わせて変更してください）
Dim validLayers() As Variant
validLayers = Array(“意匠-Wall”, “構造-Column”, “設備-Pipe”, “共通-Dimension”)
Dim errorCount As Long
errorCount = 0
‘ 2. ヘッダー出力
Debug.Print “========================================================”
Debug.Print ” [Layer Check Start] Target Page: ” & targetPage.Name
Debug.Print “========================================================”
‘ 3. ページ内の全シェイプを再帰的に走査開始
Dim shp As Visio.Shape
For Each shp in targetPage.Shapes
Call InspectShapeLayers(shp, validLayers, errorCount)
Next shp
‘ 4. 結果サマリー
Debug.Print “========================================================”
If errorCount > 0 {
Debug.Print ” [WARNING] 整合性エラー検出: ” & errorCount & ” 件の不正シェイプがあります。”
} Else {
Debug.Print ” [SUCCESS] レイヤー整合性チェック完了: 異常なし。”
End If
Debug.Print “========================================================”
MsgBox “レイヤー整合性チェックが完了しました。” & vbCrLf & _
“検出件数: ” & errorCount & ” 件” & vbCrLf & _
“詳細はイミディエイトウィンドウを確認してください。”, vbInformation, “レイヤーチェッカー”
End Sub
‘ ——————————————————————————
‘ 内部関数：シェイプを再帰的に走査し、レイヤー所属を検証する
‘ ——————————————————————————
Private Sub InspectShapeLayers(ByVal currentShp As Visio.Shape, ByRef validLayers() As Variant, ByRef errCount As Long)
On Error GoTo ErrorHandler
‘ グループシェイプの場合は、配下のサブシェイプを再帰的に叩く
If currentShp.Type = visTypeGroup Then
Dim subShp As Visio.Shape
For Each subShp In currentShp.Shapes
Call InspectShapeLayers(subShp, validLayers, errCount)
Next subShp
End If
‘ シェイプがレイヤーを持っているか判定 (LayerMember セル)
Dim layerMemberCell As Visio.Cell
If currentShp.CellExistsU(“LayerMember”, visExistsLocally) Or currentShp.CellExistsU(“LayerMember”, visExistsAnywhere) Then
Set layerMemberCell = currentShp.CellsU(“LayerMember”)
Dim assignedLayersStr As String
assignedLayersStr = layerMemberCell.ResultStr(“”)
‘ 空白（レイヤー未割当）の場合のハンドリング
If Trim(assignedLayersStr) = “” Then
‘ ※「レイヤー未割当を許容しない」ルールの場合、ここでカウント
‘ 厳密なルール適用が必要な現場ではここを有効化する
‘ LogError currentShp, “レイヤーが一切割り当てられていません。”, errCount
Else
‘ 複数レイヤーに所属している場合（セミコロン区切り）を考慮して分解
Dim layers() As String
layers = Split(assignedLayersStr, “;”)
Dim i As Long
For i = LBound(layers) To UBound(layers)
Dim cleanLayerName As String
cleanLayerName = Trim(layers(i))
If cleanLayerName <> “” Then
If Not IsLayerNameValid(cleanLayerName, validLayers) Then
LogError currentShp, “未定義のレイヤー ‘” & cleanLayerName & “‘ に所属しています。”, errCount
End If
End If
Next i
End If
End If
Exit Sub
ErrorHandler:
Debug.Print “[Error] Shape ID: ” & currentShp.ID & ” の検証中に予期せぬエラーが発生しました: ” & Err.Description
End Sub
‘ ——————————————————————————
‘ ホワイトリストとの照合ロジック
‘ ——————————————————————————
Private Function IsLayerNameValid(ByVal targetName As String, ByRef validLayers() As Variant) As Boolean
Dim v As Variant
For Each v In validLayers
If StrComp(v, targetName, vbTextCompare) = 0 Then
IsLayerNameValid = True
Exit Function
End If
Next v
IsLayerNameValid = False
End Function
‘ ——————————————————————————
‘ ログ出力フォーマッタ
‘ ——————————————————————————
Private Sub LogError(ByVal shp As Visio.Shape, ByVal message As String, ByRef errCount As Long)
errCount = errCount + 1
Debug.Print ” [Violation #” & errCount & “] ” & _
“Page: ” & shp.ContainingPage.Name & ” | ” & _
“Shape ID: ” & shp.ID & ” | ” & _
“Shape Name: ” & shp.Name & ” | ” & _
“Reason: ” & message
End Sub
—
4. 運用上の注意点とさらなる拡張
このスクリプトを実務のビルドパイプラインや定例の図面監査フローに組み込むにあたり、以下のポイントを押さえておくべきだ。
1. 外部データベース・Excel連携への発展
上記のコードではイミディエイトウィンドウに出力しているが、実務では数千件のログをExcelやCSVに吐き出す必要がある。`CreateObject(“Excel.Application”)` を用いて、検出されたエラーログ（ページ名、シェイプID、名称、不正レイヤー名）を自動的にExcelのシートへ構造化してエクスポートするラッパーを追加すると、監査レポートとしての価値が劇的に向上する。
2. Visioの「マスターシェイプ」の扱い
このコードはあくまで「ページ上に配置されたインスタンス（`ActivePage.Shapes`）」を対象としている。ステンシル内のマスターシェイプ自体のレイヤー構造を検査したい場合は、`ActiveDocument.Masters` を走査対象に切り替えるアーキテクチャが必要となる点に留意してほしい。
—
総括
Visio VBAは、ただ動くだけのコードを書く場所ではない。巨大な図面オブジェクトのメモリ構造を理解し、無駄なCOMラウンドトリップを排除した上で、ロジカルに整合性を担保する。
この「レイヤー整合性チェッカー」をあなたの開発環境に導入し、図面品質のガバナンスを次の次元へと引き上げてほしい。
