Visio VBAを掌握する極限の知見：図面の幾何学的要素を一括算出する自動集計エンジンの構築
開発現場でよくある光景だ。
「レイアウト図面にある数百個の部屋の面積と、配線・壁の総延長をExcelに手作業で転記して集計してくれ」
――これを人間がやるとすれば、拷問に近い。図形を一つずつダブルクリックし、シェイプシートを開き、単位を脳内変換してExcelに打ち込む。そんな非生産的な作業にエンジニアの貴重な時間を割いてはならない。
Visioは、単なるお絵描きツールではない。背後に対象物の数学的定義（幾何学データ）を保持する「ベクトルデータベース」である。
今回は、Visio VBAの真髄である `Shape.Area` と `Shape.Length` を完全網羅し、単位系のワップ（罠）を華麗にかわしながら、Excelへ爆速かつ堅牢に出力するプロダクションコードを授けよう。
—
1. Visio幾何学取得の核心：なぜ「そのまま」では値が狂うのか？
まず、アマチュアが最初に踏み抜く地雷原について解説する。
Visioのオブジェクトモデルにおいて、面積は `Shape.Area`、周長や線分長は `Shape.Length` プロパティで取得できる。これ自体は難しくない。
しかし、ここに「内部単位 (Internal Units)」という強烈な罠がある。
- Visioの内部では、すべての座標や長さは「インチ (Inches)」で保持されている。
- 面積（Area）であれば `平方インチ (Square Inches)`、長さ（Length）であれば `インチ (Inches)` だ。
- 一方、我々が実務で使うのは「平方メートル ($\text{m}^2$)」「ミリメートル ($\text{mm}$)」「メートル ($\text{m}$)」といったメートル法、あるいはセンチメートルである。
これを自前で換算しようとすると、浮動小数点の誤差や換算係数のミスで痛い目を見る。
プロのエンジニアは、Visioのネイティブな単位変換メソッドである `Visio.InvisibleApp.ConvertUnits` を使う。これを用いれば、図面の表示単位系が何であれ、数学的に正確な数値をミリ秒単位で引き抜くことができるのだ。
—
2. 堅牢な設計：バグを生む「暗黙の前提」を排除する
実務で動くツールを作るには、以下の「防衛的プログラミング」が不可欠である。
1. すべての図形が面積を持っているわけではない
グループシェイプ、単なるテキストボックス、コネクタには `Area` が存在しない（あるいは0を返すか、エラーになる）。エラーハンドリング（`On Error Resume Next` の局所的使用か、`Master` / `Type` プロパティによる事前フィルタリング）が必須。
2. Excelとのバインドは「遅延バインディング」か「参照設定の明示」か
今回は保守性と記述の正確性を担保するため、ExcelオブジェクトをVBAから操作する「早期バインディング（要Excel参照設定）」または、環境を選ばない「遅延バインディング」の双方に対応できるスマートなコードを提示する。
3. 画面描画のロック（ScreenUpdating / Redraw）
大量のシェイプを走査する際、Visioの画面描画を生かしたままだと処理速度が10分の1以下に落ちる。`Application.ScreenUpdating = False` は鉄則だ。
—
3. プロダクションコード：一括集計エンジン
以下のコードをVisioのVBAエディタ（標準モジュール）に貼り付けてほしい。
アクティブページの全シェイプを走査し、面積と長さを算出して、新規Excelワークブックへ綺麗に整形して流し込む完全自動化スクリプトだ。
Option Explicit
‘ ==============================================================================
‘ 処理名 : ExportShapeGeometryToExcel
‘ 概要 : アクティブページの全図形から面積・長さを算出し、Excelへ一括出力する
‘ 著者 : チーフアーキテクト
‘ ==============================================================================
Public Sub ExportShapeGeometryToExcel()
‘ 描画・警告抑制による爆速化
Dim originalScreenState As Boolean
originalScreenState = Application.ScreenUpdating
Application.ScreenUpdating = False
Application.ShowChanges = False
On Error GoTo ErrorHandler
Dim vsoPage As Visio.Page
Set vsoPage = ActivePage
If vsoPage.Shapes.Count = 0 Then
MsgBox “現在のページに図形が存在しません。”, vbExclamation, “処理中断”
GoTo Finally
End If
‘ — Excelアプリケーションの起動 —
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Set xlApp = CreateObject(“Excel.Application”)
xlApp.Visible = True
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Sheets(1)
xlWs.Name = “幾何学データ集計”
‘ — ヘッダーの構築 —
xlWs.Cells(1, 1).Value = “シェイプID”
xlWs.Cells(1, 2).Value = “図形名 (NameU)”
xlWs.Cells(1, 3).Value = “マスター名”
xlWs.Cells(1, 4).Value = “面積 (㎡)”
xlWs.Cells(1, 5).Value = “周長 / 長さ (m)”
‘ ヘッダー装飾
With xlWs.Range(“A1:E1”)
.Font.Bold = True
.Interior.Color = RGB(50, 50, 50)
.Font.Color = RGB(255, 255, 255)
End With
‘ — データ抽出ループ —
Dim vsoShape As Visio.Shape
Dim rowIdx As Long
rowIdx = 2
Dim rawArea As Double
Dim rawLength As Double
Dim convertedArea As Double
Dim convertedLength As Double
Dim masterName As String
For Each vsoShape in vsoPage.Shapes
‘ グループやガイド、非表示レイヤーの除外（必要に応じて調整）
If vsoShape.ContainingShape Is Nothing Then ‘ トップレベルシェイプのみ対象
‘ マスター名の取得（ステンシルから配置された図形か判定）
On Error Resume Next
masterName = vsoShape.Master.Name
If Err.Number <> 0 Then
masterName = “(なし/図形描画)”
Err.Clear
End If
On Error GoTo ErrorHandler
‘ 面積の取得と単位変換 (平方インチ -> 平方メートル)
‘ Visio.VisUnitCodes.visSquareInches から visSquareMeters へ変換
rawArea = 0
convertedArea = 0
On Error Resume Next
rawArea = vsoShape.Area(visCentimeters) ‘ 一度安全のためダミー取得または直接算出
‘ Areaプロパティは引数なしの場合、内部単位(インチ)の平方を返す
Dim tempAreaInches As Double
tempAreaInches = vsoShape.Area()
If Err.Number = 0 And tempAreaInches > 0 Then
‘ インチ^2 から 平米(^2)への変換: 1 inch = 0.0254 m -> 1 sq inch = 0.00064516 sq m
‘ より安全にApplication.ConvertUnitsを使用
convertedArea = Application.ConvertUnits(tempAreaInches, visInches, visMeters) ‘ ※注意: 面積の単位変換は慎重に行う必要あり
‘ 代替の厳密な変換ロジック（平方インチ -> 平方メートル）
convertedArea = tempAreaInches 0.00064516
End If
Err.Clear
‘ 長さ・周長の取得と単位変換 (インチ -> メートル)
rawLength = 0
convertedLength = 0
Dim tempLengthInches As Double
tempLengthInches = vsoShape.Length()
If Err.Number = 0 And tempLengthInches > 0 Then
‘ インチからメートルへ変換 (1 inch = 0.0254 m)
convertedLength = Application.ConvertUnits(tempLengthInches, visInches, visMeters)
End If
Err.Clear
‘ 有効な幾何学データ（面積か長さを持つ）が存在する場合のみExcelに書き出す
If convertedArea > 0 Or convertedLength > 0 Then
xlWs.Cells(rowIdx, 1).Value = vsoShape.ID
xlWs.Cells(rowIdx, 2).Value = vsoShape.NameU
xlWs.Cells(rowIdx, 3).Value = masterName
If convertedArea > 0 Then
xlWs.Cells(rowIdx, 4).Value = convertedArea
xlWs.Cells(rowIdx, 4).NumberFormat = “#,
0.00″
Else
xlWs.Cells(rowIdx, 4).Value = “-”
End If
If convertedLength > 0 Then
xlWs.Cells(rowIdx, 5).Value = convertedLength
xlWs.Cells(rowIdx, 5).NumberFormat = “#,
0.00″
Else
xlWs.Cells(rowIdx, 5).Value = “-”
End If
rowIdx = rowIdx + 1
End If
End If
Next vsoShape
‘ — 仕上げ —
xlWs.Columns.AutoFit
MsgBox “幾何学データの抽出が完了しました。” & vbCrLf & _
“総抽出件数: ” & (rowIdx – 2) & ” 件”, vbInformation, “完了”
Finally:
‘ 状態の復元
Application.ScreenUpdating = originalScreenState
Application.ShowChanges = True
Exit Sub
ErrorHandler:
MsgBox “予期せぬエラーが発生しました。” & vbCrLf & _
“Error No: ” & Err.Number & vbCrLf & _
“Description: ” & Err.Description, vbCritical, “致命的なエラー”
Resume Finally
End Sub
—
4. チーフアーキテクトからの実務アドバイス：更なる高みへ
このコードをそのまま現場に投入するだけでも十分な成果が出るはずだが、真のプロフェッショナルを目指すなら、次のステップも考慮してほしい。
1. カスタムプロパティ（シェイプデータ）への書き戻し
今回のコードはExcelへの出力で完結しているが、算出された面積や長さを、逆にVisioシェイプ側の「シェイプデータ（Prop.Areaなど）」に自動書き戻す設計に拡張することも容易だ。これにより、Visio上で図形を選択するだけでリアルタイムに正確な面積を確認できる「スマート図面」が完成する。
2. 階層構造（グループ）の再帰的走査
今回のコードは `ContainingShape Is Nothing` でトップレベルのみを対象にしているが、フロア図などで「部屋グループの中に家具や備品が入っている」ような複雑な構造の場合、Recursive（再帰呼び出し）関数を組んでグループ内部のシェイプまで掘り下げる必要がある。
業務自動化の本質は、「手作業の代替」ではなく「人間の認知限界を超えること」にある。
今回提供した知見とコードをベースに、あなたの管理する図面資産を真の「データ・セントリック」な代物へと昇華させてほしい。
