【Visio VBA極限解説】図面上のオブジェクトから縮尺を逆算し、計測乖離をゼロにする自動化ルーチン
エンジニア諸君。日々の図面管理において、「図面上の寸法と、描かれているオブジェクトの実寸が一致しない」という悪夢のような現象に頭を悩ませてはいないか。
CADからエクスポートされた図面、あるいは非エンジニアが無造作に拡大縮小を繰り返したVisioファイル。これらをそのままプリンター出力やPDF化に回せば、縮尺の不整合による手戻り、最悪の場合は施工ミスや設計不良に直結する。Visioのデフォルトのページ設定に頼っているようでは、シニアエンジニアの看板を下ろすべきだ。
今回は、Visioのドキュメント構造の深部をハックし、図面上のオブジェクトの物理サイズと、それが持つべき論理的寸法の乖離を検出し、最適な「図面縮尺（Scale）」を自動計算してページ設定へ強制適用するための、実務直結型VBAルーチンを公開する。
—
1. Visioの「縮尺（Scale）」が孕む構造的罠
Visioのページ設定（`Page.PageScale`, `Page.DrawingScale`）は、GUIからは直感的に見えるが、VBAから操作する際には極めて厄介な仕様を持っている。
一般的な図面では、以下の関係性が成り立っている。
- ページ単位の物理サイズ（Page Width / Height）：用紙そのもののサイズ（例: A3なら420mm × 297mm）
- 図面尺度（Drawing Scale）：用紙上の1インチ/1mmが、現実世界のどれだけの長さ（例: 1:100）に相当するか。
- ページ尺度（Page Scale）：複数ページ間で統一するための補正係数。
ここで発生する問題は、「ユーザーが図形をフリーハンドで拡大・縮小すると、ShapeのGeometry自体は変わるが、ページのDrawingScaleは追従しない」という点だ。結果として、図面上の「10mの壁」を描く線が、内部的には「実際の100mm」として処理されるような致命的な乖離が生まれる。
この乖離をプログラムによって数学的に補正し、真の縮尺を再計算するアーキテクト視点の実装を解説する。
—
2. 実装アーキテクチャの全体像
今回の自動化ルーチンの要件は以下の通りである。
1. 基準図形の特定: 縮尺の基準となる既知の寸法を持つ図形（あるいは特定のレイヤー・カスタムプロパティを持つ図形）を特定する。
2. 物理長と論理長の比較: 図形が持つ実際の幅（`PinX`/`Width`等）と、保持すべきメタデータ（ShapeSheetのUser定義セルなど）を比較。
3. 縮尺の自動逆算: 理想値と現在値の比率から、Visioの`DrawingScale`を動的に書き換える。
4. オブジェクトの完全解放: Visio VBA特有のCOMメモリリークを防ぐため、すべてのオブジェクト変数を明示的に破棄する。
—
3. 実務直結・プロダクションコード
以下のコードは、エラーハンドリング、メモリ最適化、そしてVisioのCOMラッパーの挙動を熟知した上で記述されたプロダクションコードである。コピペし、必要に応じて基準となるプロパティ名を変更して使用してほしい。
Option Explicit
‘ ==============================================================================
‘ 処理名 : AutoAdjustDrawingScale
‘ 概要 : 基準図形の物理寸法と論理寸法からページ縮尺を逆算し、ページ設定を自動補正する
‘ 備考 : シニアエンジニア向け実務対応版（COMメモリ最適化・厳格な型指定）
‘ ==============================================================================
Public Sub AutoAdjustDrawingScale()
‘ — 変数宣言（スコープを明確にし、メモリリークを防ぐ） —
Dim vsoApp As Visio.Application
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim dblActualWidth As Double
Dim dblLogicalWidth As Double
Dim dblCurrentScale As Double
Dim dblNewScale As Double
‘ エラーハンドリング設定
On Error GoTo ErrorHandler
‘ アプリケーションインスタンスの取得（GetObject経由で現在のコンテキストを維持）
Set vsoApp = Visio.Application
Set vsoPage = vsoApp.ActivePage
‘ ページが存在するか確認
If vsoPage Is Nothing Then
MsgBox “アクティブなページが存在しません。”, vbCritical, “スケール自動化エラー”
GoTo CleanUp
End If
‘ — Step 1: 基準となる図形の特定 —
‘ ここでは「Prop.TargetWidth」というカスタムプロパティ（シェープシート）を持つ図形を基準とする
Set vsoShape = GetReferenceShape(vsoPage)
If vsoShape Is Nothing Then
MsgBox “基準となる図形（Prop.TargetWidthを持つシェープ）が見つかりません。”, vbExclamation, “縮尺補正”
GoTo CleanUp
End If
‘ — Step 2: 物理長と論理長の取得 —
‘ Visio内部の図形幅（単位：インチ）
dblActualWidth = vsoShape.CellsU(“Width”).ResultIU
‘ シェープシートのUser定義セルまたはカスタムプロパティから「本来あるべき現実世界の長さ（メートル等）」を取得
‘ ※今回は例として “Prop.TargetWidth.Value” に格納されていると仮定 (単位: メートル)
On Error Resume Next
dblLogicalWidth = vsoShape.CellsU(“Prop.TargetWidth”).ResultIU
If Err.Number <> 0 Then
MsgBox “基準図形に論理寸法（Prop.TargetWidth）が正しく定義されていません。”, vbCritical, “エラー”
On Error GoTo ErrorHandler
GoTo CleanUp
End If
On Error GoTo ErrorHandler
If dblActualWidth <= 0 Or dblLogicalWidth <= 0 Then MsgBox "無効な寸法値が検出されました。処理を中止します。", vbCritical, "エラー" GoTo CleanUp End If ' --- Step 3: 縮尺の逆算と適用 --- ' 現在のDrawingScaleDenominator（縮尺の分母）を取得 ' 例: 1/100スケールの場合、DrawingScale = 1m, DrawingScaleDenominator = 100 などの関係性を調整 ' ここでは簡略化のため、現在のページスケール比率を元に補正値を算出 ' ログ出力（イミディエイトウインドウで確認） Debug.Print "--- 縮尺自動計算ログ ---" Debug.Print "物理幅 (Inch): " & dblActualWidth Debug.Print "論理幅 (Meters): " & dblLogicalWidth ' ページの既存設定を取得し、比例計算に基づいてDrawingScaleを再構築 ' Visioのページ設定における縮尺ロジック： ' DrawingScale = PageScale ScaleFactor ' トランザクションの開始（VisioのUndoバッファを1つにまとめる） vsoApp.BeginUndoScope "ページ縮尺の自動補正" ' 例として、ミリメートル単位系での逆算処理 ' ページ設定の DrawingScale を書き換える ' ※図面の単位系（メートル、ミリメートル等）に合わせて係数を調整すること With vsoPage ' 既存の比率を維持したまま、新しいスケール値を適用 ' DrawingScaleを 1 [Drawing Unit] = X [Page Unit] の関係に落とし込む .DrawingScale = dblLogicalWidth / dblActualWidth End With vsoApp.EndUndoScope True MsgBox "縮尺の自動補正が完了しました。", vbInformation, "正常終了" GoTo CleanUp ErrorHandler: If Not vsoApp Is Nothing Then vsoApp.EndUndoScope False End If MsgBox "予期せぬエラーが発生しました: " & Err.Description, vbCritical, "致命的エラー" CleanUp: ' --- Step 4: オブジェクトの明示的解放 (Memory Optimization) --- ' VBAのCOMオブジェクト参照を完全に破棄し、メモリリーク・Visioのゾンビプロセス化を防ぐ Set vsoShape = Nothing Set vsoPage = Nothing Set vsoApp = Nothing End Sub ' ============================================================================== ' 補助関数 : 基準図形の検索 ' ============================================================================== Private Function GetReferenceShape(ByRef vsoPage As Visio.Page) As Visio.Shape Dim shp As Visio.Shape Dim foundShp As Visio.Shape Set foundShp = Nothing For Each shp in vsoPage.Shapes ' シェープに "Prop.TargetWidth" セルが存在するかどうかを安全にチェック If CellExists(shp, "Prop.TargetWidth") Then Set foundShp = shp Exit For End If Next shp Set GetReferenceShape = foundShp Set shp = Nothing End Function ' ============================================================================== ' 補助関数 : セル存在確認の安全ラッパー ' ============================================================================== Private Function CellExists(ByRef shp As Visio.Shape, ByVal cellName As String) As Boolean Dim val As Double On Error Resume Next val = shp.CellsU(cellName).ResultIU If Err.Number = 0 Then CellExists = True Else CellExists = False End If On Error GoTo 0 End Function ---
4. コードの深層解説：なぜこの実装なのか？
1. `BeginUndoScope` によるトランザクション管理
VisioのVBAでは、幾何学的計算やページプロパティの書き換えを連続して行うと、ユーザーの「Ctrl + Z（元に戻す）」の履歴が細切れになり、実用に耐えなくなる。
`vsoApp.BeginUndoScope` と `EndUndoScope True` で囲むことにより、一連の縮尺計算とページ設定変更を「単一のUndoアクション」としてカプセル化している。これはエンタープライズ環境におけるUI/UXの基本要件だ。
2. COMオブジェクトの参照切断（`Set … = Nothing`）
VBAにおける最大の悪習は、オブジェクト変数を解放せずにプロシージャを終了することだ。特にVisioのCOMオブジェクトは強力な参照カウンタを持っているため、これを放置するとExcelやVisioがバックグラウンドでゾンビプロセスとして残り続け、メモリリークを引き起こす。
今回のコードでは、`CleanUp` ラベルを用意し、いかなるエラーパスを通ろうとも確実に `Nothing` を代入してメモリを解放する設計にしている。
3. `CellsU` と シェープシートの直接叩き
GUIプロパティ（例: `Page.PageScale` 等）に依存するのではなく、底辺にある ShapeSheet (`CellsU`) を直接操作している点に注目してほしい。UI言語（日本語版・英語版）の違いによるプロパティ名の揺らぎを完全に排除し、グローバル名称（Universal Names）で確実なアクセスを担保している。レガシー環境や多言語環境が混在するグローバル企業において、この仕様は必須の知見である。
—
5. システム間連携への展開
この自動化ルーチン単体でも強力だが、さらなる高みを目指すシニアエンジニアであれば、これを外部システム（ERPやCAD管理サーバー、WebAPI）との連携に昇華させるべきだ。
- 設計DBからのパラメータ取得: 図面を開いた瞬間に、DBから「この図面の本来の縮尺および基準寸法のメタデータ」をJSON等で取得し、上記のVBAへ流し込む。
- 完全無人バッチ処理（Headless Mode）: Visioを非表示（`Visio.Application.Visible = False`）のままタスクスケューラから起動し、大量の図面群に対して一括で縮尺の乖離を修正・上書き保存するパイプラインを構築する。
人間の目視による計測ミスや、「何となくの縮尺設定」をシステム的・数学的に駆逐すること。それこそが、我々エンジニアが自動化ツールに込めるべき美学である。
現場のコードに組み込み、今すぐその「計測値のズレ」という呪縛から解放されよ。
