Visio VBAを掌握する極限の知見：幾何学演算の罠と自動集計エンジンの実装
幾何学的な図形の面積（`Area`）や周長（`Length`）の集計。一見して単純なプロパティの読み出しに見えるこの処理こそ、Visio VBAの深淵――「内部単位系と表示単位系の乖離」「巨大なCOMオブジェクト群のメモリリーク」「暗黙の型変換による精度破綻」の地雷原である。
本稿では、Visioのドキュメント構造の奥底に潜む仕様を暴き、Excelとの連携によってミリ秒単位で巨大図面を解析・集計する、実戦投入可能な最高峰の自動集計エンジンを提示する。
—
1. Visioオブジェクトモデルの極限：幾何学プロパティの真実
多くの初学者は、`Shape.Area` や `Shape.Length` を呼び出せば、画面上に表示されている「平方メートル」や「メートル」がそのまま返ってくると錯覚する。ここに致命的な設計ミスが生まれる。
内部単位（Internal Units）の絶対性
VisioのCOM APIが返す数値は、UI上の表示単位に関わらず、すべて「内部単位（通常はインチ、またはラジアン）」である。
さらに悪いことに、`Shape.Area` は二次元的な面積（平方インチ）、`Shape.Length` は一次元的な長さ（インチ）を返す。これをそのままExcelに出力すれば、建築図面やネットワーク配線図のデータとしては使い物にならない。
さらに、`Shape.Area` はすべてのシェイプで評価できるわけではない。1Dシェイプ（直線やコネクタ）や、閉じていないパスを持つグループシェイプに対して実行すると、ランタイムエラー（あるいは不正確な0の値）を返す。エンジニアは、必ずシェイプの次元（`OneD` プロパティ）やマスターシェイプの特性を事前にフィルタリングしなければならない。
—
2. 実装：幾何学一括集計エンジン（Visio to Excel）
以下のコードは、アクティブなVisio図面の全ページ（あるいは指定ページ）を走査し、各シェイプの正確な物理面積（$\text{m}^2$ または $\text{cm}^2$）および周長・長さを算出、即座にExcelのワークシートへ高速転送するプロフェッショナル向けのマクロである。
画面描画のロック（`ScreenUpdating`）とイベントの無効化を徹底し、COMのラウンドトリップコストを極限まで削ぎ落としている。
Option Explicit
‘ ==============================================================================
‘ 致命的なパフォーマンス低下を防ぐための定数定義
‘ ==============================================================================
Private Const INCH_TO_METER As Double = 0.0254
Private Const SQ_INCH_TO_SQ_METER As Double = INCH_TO_METER INCH_TO_METER
Sub ExportGeometryMetricsToExcel()
Dim appVisio As Visio.Application
Set appVisio = Visio.Application
‘ 実行前の最適化：描画更新と自動計算を停止し、処理速度を限界まで引き上げる
Dim origScreenUp As Boolean
origScreenUp = appVisio.ScreenUpdating
appVisio.ScreenUpdating = False
appVisio.EventsEnabled = False
Dim excelApp As Object
Dim excelWB As Object
Dim excelWS As Object
On Error GoTo ErrorHandler
‘ Excelのインスタンスを遅延バインディングで生成（バージョン依存を回避）
Set excelApp = CreateObject(“Excel.Application”)
excelApp.Visible = True
excelApp.DisplayAlerts = False
Set excelWB = excelApp.Workbooks.Add
Set excelWS = excelWB.Sheets(1)
excelWS.Name = “Geometry_Metrics”
‘ ヘッダーの書き込み
excelWS.Cells(1, 1).Value = “ページ名”
excelWS.Cells(1, 2).Value = “シェイプID”
excelWS.Cells(1, 3).Value = “マスター名”
excelWS.Cells(1, 4).Value = “シェイプ名”
excelWS.Cells(1, 5).Value = “分類 (1D/2D)”
excelWS.Cells(1, 6).Value = “面積 (㎡)”
excelWS.Cells(1, 7).Value = “周長 / 長さ (m)”
Dim rowIdx As Long
rowIdx = 2
Dim vPage As Visio.Page
Dim vShape As Visio.Shape
‘ 図面内の全ページを走査
For Each vPage In appVisio.ActiveDocument.Pages
‘ バックグラウンドページは除外
If Not vPage.Background Then
‘ 効率的な走査のため、再帰的にシェイプを処理
Call ProcessShapesRecursive(vPage.Shapes, excelWS, rowIdx, vPage.Name)
End If
Next vPage
‘ 列幅の自動調整
excelWS.Columns(“A:G”).AutoFit
MsgBox “幾何学データの抽出が完了しました。”, vbInformation, “Visio Architecture Engine”
CleanUp:
‘ 状態の復元（例外発生時も確実に戻す）
appVisio.ScreenUpdating = origScreenUp
appVisio.EventsEnabled = True
‘ オブジェクトの明示的解放（メモリリーク防止）
Set excelWS = Nothing
Set excelWB = Nothing
Set excelApp = Nothing
Exit Sub
ErrorHandler:
MsgBox “致命的なエラーが発生しました: ” & Err.Description, vbCritical, “System Error”
Resume CleanUp
End Sub
‘ ==============================================================================
‘ 再帰的シェイプ走査プロシージャ（グループ化された構造に対応）
‘ ==============================================================================
Private Sub ProcessShapesRecursive(shpCol As Visio.Shapes, ws As Object, ByRef rIdx As Long, pageName As String)
Dim shp As Visio.Shape
Dim masterName As String
Dim areaVal As Double
Dim lengthVal As Double
Dim shapeType As String
For Each shp in shpCol
‘ マスターシェイプ名の安全な取得
On Error Resume Next
If Not shp.Master Is Nothing Then
masterName = shp.Master.Name
Else
masterName = “(なし)”
End If
On Error GoTo 0
‘ グループシェイプ自体のコンテナか、通常のシェイプかを判定
If shp.Type = visTypeGroup Then
‘ グループ内の子シェイプを再帰処理
Call ProcessShapesRecursive(shp.Shapes, ws, rIdx, pageName)
Else
areaVal = 0#
lengthVal = 0#
‘ 2Dシェイプ（面積評価が可能）
If shp.OneD = 0 Then
shapeType = “2D Shape”
On Error Resume Next
‘ Shape.Area は平方インチを返すため、平方メートルに換算
areaVal = shp.Area SQ_INCH_TO_SQ_METER
If Err.Number <> 0 Then areaVal = 0#
On Error GoTo 0
Else
‘ 1Dシェイプ（配線や壁、直線など。Lengthを評価）
shapeType = “1D Shape”
On Error Resume Next
‘ Shape.Length はインチを返すため、メートルに換算
lengthVal = shp.Length INCH_TO_METER
If Err.Number <> 0 Then lengthVal = 0#
On Error GoTo 0
End If
‘ 意味のあるデータ（面積または長さを持つ）のみExcelに出力
If areaVal > 0 Or lengthVal > 0 Then
ws.Cells(rIdx, 1).Value = pageName
ws.Cells(rIdx, 2).Value = shp.ID
ws.Cells(rIdx, 3).Value = masterName
ws.Cells(rIdx, 4).Value = shp.Name
ws.Cells(rIdx, 5).Value = shapeType
ws.Cells(rIdx, 6).Value = IIf(areaVal > 0, areaVal, “”)
ws.Cells(rIdx, 7).Value = IIf(lengthVal > 0, lengthVal, “”)
rIdx = rIdx + 1
End If
End If
Next shp
End Sub
—
3. エンジニアリングの急所：なぜこのコードなのか？
1. COMラウンドトリップの極限排除
`ws.Cells(rIdx, …)` をループ内で呼ぶのは本来アンチパターンだが、Visioのシェイプ走査とExcelへの書き込みを同時に行う場合、配列バッファリング（`Variant` 配列への一括格納）を実装すると、グループ構造の深さに応じてコードが肥大化する。実用的なパフォーマンスを保つため、描画更新（`ScreenUpdating`）とバックグラウンドイベント（`EventsEnabled`）の遮断に注力している。
2. 遅延バインディング（`CreateObject`）の採用
社内システムやクライアント端末において、Excelのバージョン（Office 2016, 2019, 365など）はバラバラである。静的参照（`Early Binding`）はバージョン差異によるコンパイルエラー（Type Mismatch）を引き起こすため、商用VBAでは遅延バインディング（`Late Binding`）が鉄則となる。
3. 安全なエラーハンドリング（`On Error Resume Next` の正しい飼いならし）
`Shape.Area` や `Shape.Master` は、不正なジオメトリを持つレガシー図面において平気で例外を吐く。エラーを握り潰すのではなく、失敗したプロパティのみを `0` にフォールバックさせ、全体の処理を止めない堅牢性を担保している。
—
4. チーフアーキテクトからの警鐘
Visio VBAによる自動化は、図面の複雑化（特にCADからのインポート図面における膨大なパスデータ）に伴い、メモリ管理の破綻という壁に突き当たる。
数千個のシェイプを持つ図面を処理する際、オブジェクト変数をループ内で適切に解放しない、あるいはイベントを有効にしたまま走査を行うと、Visioプロセスは確実にメモリリークを起こしてフリーズする。
今回提供したアーキテクチャをベースに、自社の業務フローに合わせたフィルタリング条件（特定のレイヤーのみ集計、カスタムプロパティの抽出など）を拡張してほしい。コードは常に、シンプルで、美しく、そして残酷なまでに堅牢でなければならない。
