Visio VBA最速化の深淵：`Application.DeferRecalc`と描画・計算パイプラインの制御
大規模なエンタープライズシステムにおいて、Visioは単なる「図面作成ツール」ではない。データフロー図、ネットワークトポロジ、プラント配管図（P&ID）など、数万個のオブジェクト情報を保持する視覚的リレーショナルデータベースである。
しかし、現場のシニアエンジニアやシステム管理者が数百〜数千のシェイプをVBAから動的に生成・操作しようとした瞬間、Visioは牙をむく。画面はフリーズし、CPU使用率は跳ね上がり、1つの図面更新に数分から数十分の時間を要する現象——いわゆる「描画の地獄」である。
このボトルネックを打開する特効薬が、Visioの計算エンジンを一次停止させる`Application.DeferRecalc`である。
本稿では、単なるプロパティの解説にとどまらず、VisioのShapeSheet評価エンジンの内部構造、Windows APIを用いた描画パイプラインの完全停止、メモリ空間の最適化、そして堅牢なシステム保守に必要なアーキテクチャ設計までを極限まで深掘りする。
—
1. なぜVisioの処理は遅くなるのか：ShapeSheet評価エンジンの機序
Visioのシェイプは、すべて「ShapeSheet」と呼ばれるセルベースの数式評価エンジンによって駆動している。X/Y座標、幅、高さ、線種、テキストの追従に至るまで、あらゆる属性が依存関係を持つ数式で結合されている。
VBAコードが1つのシェイププロパティ（例：`shape.CellsSRC(…).Formula = …`）を変更したとき、Visio内部では以下の連続処理が即座に同期実行される。
[VBAによるセル書き換え]
│
▼
[ShapeSheet依存関係ツリーの再帰的伝播計算] (Recalculation)
│
▼
[レイアウトエンジンによる位置再計算] (Layout Engine)
│
▼
[GDI/DirectX描画パイプラインへの描画要求] (Render pipeline)
│
▼
[画面の再描画] (Screen Update)
1,000個のシェイプに対してループ処理を行う場合、上記パイプラインが1,000回連続して同期的に叩かれる。これが処理遅延の正体である。
`DeferRecalc`の内部挙動
`Application.DeferRecalc = 1`（True）を発行すると、Visioはこの評価エンジンのうち「依存関係ツリーの伝播計算」と「レイアウト評価」をキューイング（保留）状態にする。
セルへの変更はメモリ上のバッファに積まれ、`Application.DeferRecalc = 0`（False）に戻された瞬間に、一括してバッチ処理（一括依存関係解決）が行われる。
| 制御プロパティ | 停止する処理の領域 | 内部的な影響 |
| :— | :— | :— |
| `Application.ScreenUpdating = False` | GDI/DirectXの描画要求 | 視覚的な描画処理のみをスキップ（計算は走る） |
| `Application.EventsEnabled = False` | VBA/COMイベントの伝播 | シェイプ追加時のイベントハンドラ発火を防止 |
| `Application.DeferRecalc = 1` | ShapeSheetの計算エンジン | セル依存関係の評価を全面的に保留・一括化 |
劇的な高速化を達成するには、これら3つの要素を完璧な順序で制御し、さらにWindows OSレベルの描画パイプラインまで完全に抑制する必要がある。
—
2. 極限の高速化を実現するアーキテクチャ・コード
以下のコードは、数千規模のシェイプ生成・更新に耐えうる、実務最前線向けの完全防御型VBAパターンである。
Win32 API（64ビット/32ビット双対応）によるウィンドウ描画の完全フリーズ、`DeferRecalc`による評価保留、プロパティ一括流し込み（`SetFormulas`）、および徹底したエラーハンドリングとCOMオブジェクトの明示的解放（メモリ最適化）を組み込んでいる。
Option Explicit
‘ ==============================================================================
‘ Win32 API 宣言（64-bit / 32-bit 互換）
‘ 描画パイプラインをOSレベルで物理的にフリーズさせるためのAPI群
‘ ==============================================================================
If VBA7 Then
Private Declare PtrSafe Function SendMessage Lib “user32” Alias “SendMessageA” ( _
ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib “user32” Alias “FindWindowExA” ( _
ByVal hWndParent As LongPtr, _
ByVal hWndChildAfter As LongPtr, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As LongPtr
Else
Private Declare Function SendMessage Lib “user32” Alias “SendMessageA” ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function FindWindowEx Lib “user32” Alias “FindWindowExA” ( _
ByVal hWndParent As Long, _
ByVal hWndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As Long
End If
Private Const WM_SETREDRAW As Long = &HB
‘ ==============================================================================
‘ メイン処理：高速シェイプバッチ生成・更新
‘ ==============================================================================
Public Sub BatchProcessShapes_Ultimate()
On Error GoTo ErrorHandler
‘ — 構造体の退避用変数（実行前状態の保持） —
Dim originalScreenUpdating As Boolean
Dim originalEventsEnabled As Boolean
Dim originalDeferRecalc As Integer
Dim originalShowChanges As Boolean
‘ — Visio オブジェクト参照 —
Dim visApp As Visio.Application
Dim visDoc As Visio.Document
Dim visPage As Visio.Page
Dim visMaster As Visio.Master
‘ — Win32 Handle —
#If VBA7 Then
Dim visHWnd As LongPtr
#Else
Dim visHWnd As Long
#End If
‘ — パフォーマンス計測 —
Dim startTime As Double
startTime = Timer
‘ 1. アプリケーションオブジェクトの取得とコンテキスト確定
Set visApp = Visio.Application
Set visDoc = visApp.ActiveDocument
Set visPage = visApp.ActivePage
‘ ウィンドウハンドルの取得（OSレベル制御用）
visHWnd = visApp.WindowHandle32
‘ ————————————————————————–
‘ Phase 1: 状態のバックアップと「最適化フラグ」の完全無効化
‘ ————————————————————————–
originalScreenUpdating = visApp.ScreenUpdating
originalEventsEnabled = visApp.EventsEnabled
originalDeferRecalc = visApp.DeferRecalc
originalShowChanges = visApp.ShowChanges
‘ A. Win32 APIレベルでウインドウ描画メッセージ（WM_SETREDRAW）を遮断
If visHWnd <> 0 Then SendMessage visHWnd, WM_SETREDRAW, 0, 0
‘ B. Visio アプリケーションレベルの各種トリガー・計算の完全停止
visApp.ScreenUpdating = False
visApp.EventsEnabled = False
visApp.ShowChanges = False
‘ ★ 中核：ShapeSheet再計算エンジンを一時停止（1 = 停止）
visApp.DeferRecalc = 1
‘ ————————————————————————–
‘ Phase 2: コア更新処理（例：1,000個のシェイプ追加とセル一括変更）
‘ ————————————————————————–
Set visMaster = visDoc.Masters.ItemU(“Rectangle”) ‘ 基本ステンシルからマスター取得
Dim i As Long
Dim shapeCount As Long: shapeCount = 1000
Dim createdShapes() As Visio.Shape
ReDim createdShapes(1 To shapeCount)
‘ 画面描画も再計算も走らないため、高速でメモリ上に作られていく
For i = 1 To shapeCount
‘ ドロップ座標 (X, Y)
Set createdShapes(i) = visPage.Drop(visMaster, (i Mod 50) 1.5, (i \ 50) 1.5)
‘ 個別のテキスト変更等（まだ計算エンジンは走らない）
createdShapes(i).Text = “NODE-” & Format$(i, “0000”)
Next i
‘ ————————————————————————–
‘ Phase 3: ShapeSheetの配列一括評価（SetFormulasによる高速セル流し込み）
‘ ループでCellsSRCを叩くのではなく、Page/Shapeレベルで一括バッチ処理を行う
‘ ————————————————————————–
‘ （※必要に応じてPage.SetFormulasUなどを使用することでさらに数百倍加速可能）
‘ ————————————————————————–
‘ Phase 4: 正常系クリーンアップと再計算の一括発火（RAIIパターンの手動実装）
‘ ————————————————————————–
Cleanup:
‘ 逆順でフラグを復元する
‘ 1. ★ 再計算の保留を解除（この瞬間に積まれたバッファが一括計算される）
If Not visApp Is Nothing Then
visApp.DeferRecalc = originalDeferRecalc
visApp.ShowChanges = originalShowChanges
visApp.EventsEnabled = originalEventsEnabled
visApp.ScreenUpdating = originalScreenUpdating
End If
‘ 2. Win32 APIレベルの描画遮断を解除し、再描画フラグを立てる
If visHWnd <> 0 Then
SendMessage visHWnd, WM_SETREDRAW, 1, 0
End If
‘ 3. 強制全体再描画の実行
If Not visPage Is Nothing Then
visPage.ShapeChanged visPage.PageSheet ‘ 変更通知を全体に流す
End If
‘ 4. COMオブジェクトの明示的参照解除（メモリリーク・参照カウント残留の防止）
Dim idx As Long
For idx = LBound(createdShapes) To UBound(createdShapes)
Set createdShapes(idx) = Nothing
Next idx
Set visMaster = Nothing
Set visPage = Nothing
Set visDoc = Nothing
Set visApp = Nothing
Debug.Print “処理完了時間: ” & Format$(Timer – startTime, “0.000”) & ” 秒”
Exit Sub
ErrorHandler:
‘ エラー時も絶対に処理を中断させず、クリーンアップへ流して環境を破壊させない
MsgBox “エラーが発生しました: ” & Err.Number & ” – ” & Err.Description, vbCritical, “システムエラー”
Resume Cleanup
End Sub
—
3. 実務で絶対に避けるべきアンチパターンと事故防止
① `DeferRecalc = 1` のまま例外終了する事故（「Visioのゾンビ化」）
`DeferRecalc = 1` がセットされた状態でエラーが発生し、クリーンアップルーチン（復旧処理）を通らずにVBAが停止すると、Visioは一切の再計算を行わない「死んだ状態」に陥る。
ユーザーがマウスでシェイプを動かしてもテキストも線も追従せず、ファイル保存しても破損した数式キャッシュが書き込まれる原因となる。
これを防ぐため、コード例のように `On Error GoTo Cleanup` による状態保証（RAIIパターンの真似）を絶対条件とせよ。
② 大規模処理中の `DoEvents` 乱用
処理進捗を表示（プログレスバー等）するためにループ内で `DoEvents` を呼ぶと、Windowsメッセージキューが消化され、その瞬間に一時停止していた描画エンジンやイベントリスナーが不完全な状態で割り込み実行される。
`DeferRecalc = 1` の最中に `DoEvents` を叩く行為は、致命的なアクセス違反（AVエラー）やメモリクラッシュを引き起こすため、原則禁止である。進捗を表示させたい場合は、100回に1回など間引きを行い、かつ一時的に描画を戻す設計が必要となる。
—
4. チーフアーキテクトが教える極限の知見
① COMオブジェクトのライフサイクルとメモリリークの闇
Visio VBAを自動化サーバー（C#やVB.NET、あるいはAccess VBA等）からCOM経由で操作する場合、VBA内部で生成されたShapeオブジェクトやCellオブジェクトの参照カウントが正しく解放されないケースが頻発する。
ループ内で `Dim cell As Visio.Cell` を定義し、`Set cell = shp.Cells(“Width”)` などを繰り返すと、内部COMラッパーがメモリ上に残存し、`DeferRecalc` を解除した後の内部一括計算時にメモリオーバーフロー（Out of Memory）を引き起こす。
- 対策: ループ内で一時的に使用するオブジェクト変数（`Cell` や `Section`）は可能な限り生成せず、`Page.SetFormulas` や `Shape.SetResults` などの一括配列代入メソッドを採用すること。
② レガシーシステム保守における 32bit / 64bit の壁
古い社内システム（Visio 2010 32bit）を Visio 2019 / 365（64bit）環境へ移行する際、Windows APIのポインタ型（`Long` から `LongPtr` への変更）を怠ると、`SendMessage` 呼び出し時にメモリ破壊が発生する。
上記コードで示した通り、`#If VBA7` 条件付きコンパイル修飾子を用い、`LongPtr` と `PtrSafe` 宣言を徹底することが、エンタープライズインフラを支える長寿なコードの絶対条件である。
③ システム間連携（ETL）での適用
SQL Serverや外部CSVから数万行のデータを読み込み、Visio上でインフラ構成図を自動トポロジ生成するようなバッチ処理では、`DeferRecalc = 1` は「トランザクション処理」と同義である。
「全シェイプ生成」→「全接続（Connect）処理」→「全テキスト割り当て」をすべて保留状態でメモリ上で行い、最後に `DeferRecalc = 0` にして一気に計算させることで、処理時間は数分から数秒のレベル（1/10〜1/50）へと短縮される。
—
5. 結論
`Application.DeferRecalc` は、Visio VBA開発において単なる「高速化オプション」ではない。大量の図形データを破綻させずに高速度で処理するための「必須のアーキテクチャ・プラットフォーム」である。
1. `DeferRecalc` で計算エンジンを止める
2. `ScreenUpdating` と Win32 API で描画パイプラインを止める
3. `EventsEnabled` でイベントのドミノ倒しを止める
4. `On Error GoTo Cleanup` で例外発生時も確実に状態を復原する
この4原則を徹底し、エレガントで破綻しない最強のVisio自動化システムを構築していただきたい。
