Visio VBAを掌握する極限の知見：Shape.Cast的アプローチ——Dictionaryを活用したメタデータ一時保持パターン
こんにちは。大規模な図面自動生成パイプラインや、複雑なファシリティマネジメントシステムをVisioで構築してきた開発プロジェクトのリーダーだ。
Visio VBAを使った開発現場で、君はこんな壁にぶつかったことはないか？
> 「図形（Shape）の処理中、一時的に発生する複雑な構造体や、外部APIから取得した非同期のJSONデータ、あるいは多次元配列を、その図形に紐づけて保持しておきたい。しかし、ShapeSheetのユーザ定義セルに書き込めるのは文字列か数値だけだ。オブジェクトをそのまま持たせることはできない……」
この課題に直面したとき、素朴なプログラマは「Shapeの `Name` や `NameID` を文字列として無理やりパースし、グローバル配列のインデックスと突き合わせる」という悪夢のような設計に手を染める。
図形が削除されたり、ユーザが手動で図形をコピペ・ID変更したりした瞬間、インデックスは狂い、VBAはメモリリークやヌル参照の海に沈む。
忘れないでほしい。VisioのShapeオブジェクト自体にカスタムプロパティ（オブジェクト参照）を生やすことはできない。
しかし、VBAの `Scripting.Dictionary` を使えば、メモリ上で完璧な「型安全なメタデータ拡張レイヤー」を構築できる。
今回は、実務の現場で「絶対に破綻しない」堅牢性を誇る、Shape.Cast的アプローチ（Dictionaryによるメタデータ一時保持パターン）の極意を伝授しよう。
—
なぜShapeSheetへの書き込みではダメなのか？
実務において、なぜShapeSheet（User-Defined Cells）への一時データ保存を避けるべきか。理由は3つある。
1. 型制約の壁：ShapeSheetが扱えるのは文字列、数値、数式のみ。オブジェクト（Class Instance）や参照型は完全に遮断される。
2. I/Oの重み：ShapeSheetへの書き込み・読み込みは、VBAの内部からCOMを叩く重い処理だ。大量の図形をループさせるアルゴリズムの中でこれをやると、実行速度が劇的に低下する。
3. ライフサイクルの不一致：図形の生死と、VBA側で一時的に必要な計算用オブジェクトの生死は別物であるべきだ。永続化すべきデータと、実行時のみ必要な「揮発性メタデータ」を混同すると、保守不能なスパゲッティコードが完成する。
ここで紹介するアプローチは、「Visioの図形は描画と固有ID（Shape.ID）の保持に徹させ、意味論的な拡張データはメモリ上のDictionaryで一元管理する」という、モダンな関心事の分離（Separation of Concerns）に基づいた設計だ。
—
設計思想：Shape.IDを主キーとしたインメモリ・リポジトリ
仕組みはシンプルだ。
`Scripting.Dictionary` のキーに `Shape.ID` （Long型）を据え、値に「独自のカスタムクラス（メタデータコンテナ）」を格納する。
[ Visio Page ]
┣━━ Shape (ID: 1) ──┐
┣━━ Shape (ID: 2) ──┼───> [ Scripting.Dictionary ]
┗━━ Shape (ID: 5) ──┘ Key: 1 ──> Value: [ClsShapeMetadata (Object)]
Key: 2 ──> Value: [ClsShapeMetadata (Object)]
Key: 5 ──> Value: [ClsShapeMetadata (Object)]
このパターンの強みは、Visioのネイティブな `Shape.ID` が図形のライフサイクルと完全に同期している点にある。図形が削除されれば、そのIDに対するDictionaryのエントリをクリアするだけでよく、メモリリークを防ぎやすい。
—
プロダクションコード実装例
実際の開発現場でそのままコピー＆ペーストして使える、堅牢なモジュール群を公開しよう。
ここでは以下の構成をとる。
1. `ClsShapeMetadata`：図形に持たせたい複雑なデータ（配列、外部ID、状態フラグなど）を保持するクラス。
2. `ModShapeManager`：Dictionaryをカプセル化し、安全なCRUD操作を提供する標準モジュール。
1. カスタムデータクラス：`ClsShapeMetadata` (Class Module)
Option Explicit
‘ 保持したいメタデータの定義（例：外部DBのID、処理ステータス、複雑な配列データ）
Private m_DatabaseId As String
Private m_ProcessStatus As Long
Private m_Payload() As String
‘ プロパティ設定・取得
Public Property Get DatabaseId() As String
DatabaseId = m_DatabaseId
End Property
Public Property Let DatabaseId(ByVal Value As String)
m_DatabaseId = Value
End Property
Public Property Get ProcessStatus() As Long
ProcessStatus = m_ProcessStatus
End Property
Public Property Let ProcessStatus(ByVal Value As Long)
m_ProcessStatus = Value
End Property
Public Sub SetPayload(ByRef arr() As String)
m_Payload = arr
End Sub
Public Function GetPayload() As String()
GetPayload = m_Payload
End Function
2. メタデータマネージャー：`ModShapeManager` (Standard Module)
Option Explicit
Private m_MetadataRepo As Scripting.Dictionary
‘ =================================================================
‘ リポジトリの初期化（処理開始時に必ず呼ぶ）
‘ =================================================================
Public Sub InitializeRepository()
Set m_MetadataRepo = New Scripting.Dictionary
‘ 大文字小文字の区別（IDなので基本関係ないが念のため）
m_MetadataRepo.CompareMode = vbBinaryCompare
End Sub
‘ =================================================================
‘ リポジトリの解放（処理終了時に必ず呼ぶ。メモリリーク防止の要）
‘ =================================================================
Public Sub TerminateRepository()
If Not m_MetadataRepo Is Nothing Then
m_MetadataRepo.RemoveAll
Set m_MetadataRepo = Nothing
End If
End Sub
‘ =================================================================
‘ メタデータの登録・更新（Cast的アプローチの核心）
‘ =================================================================
Public Function RegisterMetadata(ByVal shp As Visio.Shape, ByVal dbId As String, ByVal status As Long) As ClsShapeMetadata
Dim meta As ClsShapeMetadata
If m_MetadataRepo Is Nothing Then InitializeRepository
‘ 既に存在する場合は取得して更新、なければ新規作成
If m_MetadataRepo.Exists(shp.ID) Then
Set meta = m_MetadataRepo(shp.ID)
Else
Set meta = New ClsShapeMetadata
m_MetadataRepo.Add shp.ID, meta
End If
meta.DatabaseId = dbId
meta.ProcessStatus = status
Set RegisterMetadata = meta
End Function
‘ =================================================================
‘ メタデータの安全な取得（Cast成功時のみオブジェクトを返す）
‘ =================================================================
Public Function GetMetadata(ByVal shp As Visio.Shape) As ClsShapeMetadata
If m_MetadataRepo Is Nothing Then
Set GetMetadata = Nothing
Exit Function
End If
If m_MetadataRepo.Exists(shp.ID) Then
Set GetMetadata = m_MetadataRepo(shp.ID)
Else
Set GetMetadata = Nothing
End If
End Function
‘ =================================================================
‘ 実務でのメイン処理サンプル
‘ =================================================================
Public Sub ProcessDrawingShapes()
Dim shp As Visio.Shape
Dim pg As Visio.Page
Dim meta As ClsShapeMetadata
On Error GoTo ErrorHandler
‘ 初期化
InitializeRepository
Set pg = ActivePage
‘ 1. 図形を走査し、メモリ上でメタデータをバインド
For Each shp in pg.Shapes
‘ 例として、すべての矩形図形に対してカスタムデータを紐づける
If shp.Master.Name = “Rectangle” Then
‘ ここでDictionaryに複雑なオブジェクトを紐づける
Set meta = RegisterMetadata(shp, “DB_KEY_” & shp.ID, 100)
‘ 配列データなども自由に持たせられる
Dim dummyArr(1) As String
dummyArr(0) = “ParamA”
dummyArr(1) = “ParamB”
meta.SetPayload dummyArr
End If
Next shp
‘ 2. バインドされたメタデータを使って高速にバッチ処理を実行
For Each shp in pg.Shapes
Set meta = GetMetadata(shp)
If Not meta Is Nothing Then
‘ ShapeSheetを汚さず、メモリ上で高速にデータ処理を行える
Debug.Print “Processing Shape ID: ” & shp.ID & _
” | DB ID: ” & meta.DatabaseId & _
” | Status: ” & meta.ProcessStatus
End If
Next shp
CleanUp:
‘ 3. 必ず解放
TerminateRepository
Exit Sub
ErrorHandler:
MsgBox “予期せぬエラーが発生しました: ” & Err.Description, vbCritical
Resume CleanUp
End Sub
—
ベースの解説は以上だ。このパターンをマスターすれば、Visio VBAは単なる「お絵描きマクロ」から、高度な「図形インメモリDB処理エンジン」へと進化する。
実務の現場でぜひこの設計を取り入れ、保守性とパフォーマンスの限界を突破してほしい。
