はじめに：なぜあなたのVisio自動化は「大量生成」で暴走・フリーズするのか
エンタープライズ領域における図面自動生成システムにおいて、Visio VBAは今なお強力なソリューションです。しかし、数千点に及ぶネットワーク構成図やP&ID（配管計装図）、シーケンス図の自動生成処理を実行した際、以下のような現象にぶち当たった経験はないでしょうか。
- 処理数が数百件を超えたあたりから指数関数的に描画速度が低下する。
- バックグラウンドで自動化を回している最中に、ユーザーがクリップボードを使った瞬間、データが破壊される。
- `OutOfMemory` エラー、あるいはCOMサブシステム（`0x80010105 – Server Fault`）による突然死。
これらすべての元凶は、「画面上の図形をコピーし、ペーストして複製する」という素人スクリプトの延長線上にある実装にあります。
標準の `Selection.Copy` や `Page.Paste`、さらには `Shape.Duplicate` でさえ、内部的にはWindowsのクリップボード機構、あるいはVisioのUIイベントループと密結合しています。処理のたびにクリップボードのロック取得、Win32メッセージキューの消費、全セルの再計算（Recalc）、そして描画ツリーの同期が発生し、パフォーマンスは物理的に破綻します。
本稿では、クリップボードを一切汚染せず、メモリ領域にダイレクトにジオメトリを描画する `DrawPolyline` と、内部マスター参照を最適化して配置する `Drop` および `DropMany` を活用した、プロフェッショナル規格の超高速複製アルゴリズムを解説します。
—
1. クリップボード依存描画が引き起こすアーキテクチャ上の病理
まず、なぜ `Copy` / `Paste` がエンタープライズ用途に耐えないのか、その内部メカニズムを解剖しておきます。
[従来の悪しきアプローチ]
VBA Exec —> Win32 Clipboard Lock —> OLE/COM Data Object Store —> Paste Msg —> UI Engine Render —> Global Recalc
（※ 処理ごとにシステム全体のI/Oとメッセージループをブロック）
[本稿のアプローチ (DropMany / Direct Primitive)]
VBA Exec —> Visio In-Memory Shape Data Array —> Direct Batch Instantiation (No UI / No Event)
（※ バッファ上で一括展開。描画・再計算は最後に一括同期）
クリップボード利用の構造的欠陥
1. Win32 APIレベルの競合
WindowsのクリップボードはOS全域の共有リソースです。VBAが `Copy` を呼んだ瞬間、`OpenClipboard()` が発行されます。ここで他プロセス（Excelやブラウザ、あるいはバックグラウンドの監視ツール）がクリップボードを掴んでいると、VBAは例外を吐いて停止します。
2. Visio ShapeSheetの完全再構築コスト
`Paste` が実行されると、Visioは対象シェイプのShapeSheet（幾何学データ、ユーザー定義セル、Propセル等）をフルスキャンし、依存関係の依存グラフ（Dependency Graph）をリビルドします。これを1000回繰り返せば、$O(N^2)$ に近い再計算負荷がCPUを襲います。
3. COMオブジェクトのメモリリーク
Visio VBAの `Paste` や `Duplicate` は、内部的に一時的なCOMインターフェースを生成します。VBAのガベージコレクション（参照カウント方式）がこれを解放する前にループが高速で回転すると、非ページプールを食いつぶし、プロセスが沈没します。
—
2. メモリに優しい複製戦略：`Drop` と `DrawPolyline` の使い分け
クリップボードを回避して図形を生成・複製するアプローチには、大きく分けて2つの正解が存在します。要件に応じてこれらを使い分けるのがアーキテククトの嗜みです。
戦略A：マスターシェイプが存在する場合 ➔ `Page.Drop` / `Page.DropMany`
既存のステンシル（.vssx）やドキュメントステンシル内に存在するマスター定義から、座標を指定してダイレクトにインスタンス化します。
- メリット: スタイル、プロパティ、接続ポイントが維持される。
- 適用領域: ネットワーク機器、機器記号、標準コンポーネントの大量配置。
戦略B：純粋な動的幾何学データの場合 ➔ `Page.DrawPolyline`
座標配列（Double型の配列）をメモリ上に確保し、API一発でポリライン（多角形/折れ線）を直接描画します。
- メリット: マスターシェイプの参照オーバーヘッドすらゼロ。最速の描画速度。
- 適用領域: 配線ルート、グリッド線、ヒートマップ、カスタムグラフの描画。
—
3. 処理速度を極限まで高める3つの黄金法則
コードの実装に入る前に、Visioオブジェクトモデルを制御するうえで必須となる「3つのチューニング」を頭に刻んでください。これらを怠ると、どれほど優れたアルゴリズムも台無しになります。
① アプリケーションイベントとUI描画の完全遮断
Visioに対し、処理中の画面描画、イベント発火、自動再計算を一時停止するよう命じます。
- `Visio.Application.ScreenUpdating = 0` (画面更新停止)
- `Visio.Application.DeferRecalc = 1` (ShapeSheet再計算の遅延)
- `Visio.Application.EventsEnabled = False` (イベント通知の遮断)
② バッチ代入メソッド `SetFormulas` / `SetResults` の採用
図形を配置した後、1セルずつ `Shape.CellsSR(…).Formula` を書き込むのは悪手です。複数シェイプの複数セルに対して、配列を一括転送する `Page.SetFormulas` を使用します。
③ COMオブジェクトの厳格な参照解除
VBAの参照カウントを確実にゼロにするため、ループ内で生成した一時シェイプオブジェクトは明示的に `Set shp = Nothing` で破棄します。
—
4. プロフェッショナル実装：1,000個のシェイプを瞬時に生成・配置するVBAコード
以下に、実務でそのまま運用可能な完全なVBAモジュールを示します。
このコードは、クリップボードを一切使用せず、`DropMany` による一括インスタンス化 と `DrawPolyline` によるダイレクト描画 の双方を極限まで最適化して実証するものです。
Option Explicit
‘ ==============================================================================
‘ Visio High-Performance Shape Instantiation Engine
‘ Architecture: Non-Clipboard, Event-Suppressed, Batch Memory Allocation
‘ Author: Chief System Architect
‘ ==============================================================================
Public Sub RenderMassiveShapesEngine()
Dim visApp As Visio.Application
Dim visDoc As Visio.Document
Dim visPage As Visio.Page
Dim visMaster As Visio.Master
‘ パフォーマンス測定用
Dim startTime As Single
startTime = Timer
Set visApp = Visio.Application
Set visDoc = visApp.ActiveDocument
Set visPage = visApp.ActivePage
‘ 1. アプリケーション状態の最適化（ガード節の設定）
Dim origScreenUpdating As Boolean
Dim origEventsEnabled As Boolean
Dim origDeferRecalc As Long
origScreenUpdating = visApp.ScreenUpdating
origEventsEnabled = visApp.EventsEnabled
origDeferRecalc = visApp.DeferRecalc
On Error GoTo ErrorHandler
‘ クリティカルセクション開始：UIとイベント処理の遮断
visApp.ScreenUpdating = 0 ‘ False
visApp.EventsEnabled = False
visApp.DeferRecalc = 1 ‘ True
‘ ————————————————————————–
‘ DEMO 1: DrawPolyline を用いた超高速幾何学描画（例：背景グリッドや配線網）
‘ ————————————————————————–
Call ExecuteDirectPolylineRender(visPage)
‘ ————————————————————————–
‘ DEMO 2: DropMany を用いたマスターシェイプのクリップボードフリー大量複製
‘ ————————————————————————–
‘ ドキュメントステンシルから「Rectangle（長方形）」マスターを取得
‘ (環境に合わせてマスター名を変更してください)
On Error Resume Next
Set visMaster = visDoc.Masters(“Rectangle”)
On Error GoTo ErrorHandler
If Not visMaster Is Nothing Then
Call ExecuteBatchDropMany(visPage, visMaster, 1000)
Else
‘ マスターが存在しない場合は基本的な基本図形を作成してテスト
Dim fallbackShp As Visio.Shape
Set fallbackShp = visPage.DrawRectangle(0, 0, 1, 1)
Set visMaster = visDoc.Drop(fallbackShp, 0, 0).Master ‘ 一時的にマスター化
fallbackShp.Delete
If Not visMaster Is Nothing Then
Call ExecuteBatchDropMany(visPage, visMaster, 1000)
End If
End If
CleanExit:
‘ 2. アプリケーション状態の完全復元（リソースのクリーンアップ）
visApp.DeferRecalc = origDeferRecalc
visApp.EventsEnabled = origEventsEnabled
visApp.ScreenUpdating = origScreenUpdating
‘ 明示的なビューの再計算と強制描画
visPage.ShapeTreeRefresh
‘ 参照の解放
Set visMaster = Nothing
Set visPage = Nothing
Set visDoc = Nothing
Set visApp = Nothing
Debug.Print “極限描画処理完了: ” & Format(Timer – startTime, “0.000”) & ” 秒”
MsgBox “処理が正常に完了しました。実行時間: ” & Format(Timer – startTime, “0.000”) & ” 秒”, vbInformation
Exit Sub
ErrorHandler:
Debug.Print “CRITICAL ERROR in RenderMassiveShapesEngine: ” & Err.Description
Resume CleanExit
End Sub
‘ ==============================================================================
‘ DrawPolyline によるダイレクトメモリ描画
‘ ==============================================================================
Private Sub ExecuteDirectPolylineRender(ByTargetPage As Visio.Page)
Dim xyArray(0 To 9) As Double
Dim polyShape As Visio.Shape
‘ 座標データの定義 (X0, Y0, X1, Y1, …)
‘ 閉じた5角形（スターノード等）を想定
xyArray(0) = 1.0: xyArray(1) = 1.0
xyArray(2) = 2.0: xyArray(3) = 3.0
xyArray(4) = 4.0: xyArray(5) = 3.0
xyArray(6) = 5.0: xyArray(7) = 1.0
xyArray(8) = 1.0: xyArray(9) = 1.0
‘ 描画フラグ: visPolylineFlagsNoSpline = 0
‘ クリップボードを経由せず、直接幾何データとして構造化
Set polyShape = ByTargetPage.DrawPolyline(xyArray, 0)
‘ ライン属性の高速チューニング
polyShape.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = “THEME(” “AccentColor” “)”
Set polyShape = Nothing
End Sub
‘ ==============================================================================
‘ DropMany によるバッチ・マスター複製アルゴリズム
‘ ==============================================================================
Private Sub ExecuteBatchDropMany(ByTargetPage As Visio.Page, ByVal SourceMaster As Visio.Master, ByVal Count As Long)
If Count <= 0 Then Exit Sub
' DropManyに必要な並列配列の定義
Dim targetObjects() As Object
Dim xyArray() As Double
Dim shapeIDs() As Long
ReDim targetObjects(0 To Count - 1)
ReDim xyArray(0 To (Count 2) - 1)
ReDim shapeIDs(0 To Count - 1)
Dim i As Long
Dim xPos As Double, yPos As Double
Dim columns As Long: columns = 40 ' 40列のマトリクス配置
' メモリ上での座標計算ループ（Visio I/Oは一切発生しない）
For i = 0 To Count - 1
Set targetObjects(i) = SourceMaster
' 座標のグリッド配置計算（インチ単位）
xPos = 1.0 + (i Mod columns) 0.5
yPos = 10.0 - (i \ columns) 0.5
xyArray(i 2) = xPos
xyArray(i 2 + 1) = yPos
Next i
' --------------------------------------------------------------------------
' CORE ENGINE: DropMany APIの発行
' 単一のCOMコールで1,000個のインスタンスを生成。クリップボード関与ゼロ。
' --------------------------------------------------------------------------
Dim droppedCount As Long
droppedCount = ByTargetPage.DropMany(targetObjects, xyArray, shapeIDs)
Debug.Print droppedCount & " 個のシェイプをメモリ上でバッチ生成しました。"
' --------------------------------------------------------------------------
' SetFormulas を用いた一括プロパティ注入（必要に応じて実行）
' LoopでCellsを叩くのではなく、配列で一括設定する
' --------------------------------------------------------------------------
Call InjectDataBatch(ByTargetPage, shapeIDs, Count)
' 配列リソースの初期化
Erase targetObjects
Erase xyArray
Erase shapeIDs
End Sub
' ==============================================================================
' SetFormulas を利用したSIDベースの高速プロパティ一括注入
' ==============================================================================
Private Sub InjectDataBatch(ByTargetPage As Visio.Page, RefShapeIDs() As Long, ByVal Count As Long)
Dim SID_Cells() As String
Dim Formulas() As Variant
ReDim SID_Cells(0 To Count - 1)
ReDim Formulas(0 To Count - 1)
Dim i As Long
For i = 0 To Count - 1
' 対象シェイプのSIDと対象セル（例: FillForegnd）を指定
SID_Cells(i) = "Sheet." & RefShapeIDs(i) & "!FillForegnd"
' テキストや数式を設定（RGB値の流し込み等）
Formulas(i) = "RGB(" & (i Mod 255) & ", 100, 200)"
Next i
' ページレベルでの一括フォーミュラ設定（超高速）
ByTargetPage.SetFormulas SID_Cells, Formulas, 0
Erase SID_Cells
Erase Formulas
End Sub
---
5. ディープダイブ：COM参照ライフサイクルとメモリ解放の真実
エンタープライズ環境で本スクリプトを連続稼働させる（例: 24時間365日のバッチドキュメント生成サービス）場合、COMオブジェクトのライフサイクル制御が運用限界を左右します。
1. `Set obj = Nothing` の必要性
VBA環境（VB6ランタイムベース）は参照カウント方式（Reference Counting）でメモリを管理します。上記コード内で `Set polyShape = Nothing` や `Erase targetObjects` を明示的に行っているのは、Visioプロセス側のC++オブジェクト（`CObject` / `CShape`）に対する内部参照カウントを即座に減算させるためです。これを行わないと、VBAのサブルーチンを抜けるまでVisio側のメモリがアンマップされず、メモリリークの要因となります。
2. Guard Clause（ガバナー機構）による復旧処理の保証
コード内の `On Error GoTo ErrorHandler` および `CleanExit` ブロックの構造に注目してください。
大量処理の途中で万が一例外（座標のオーバーフローや内部C++例外など）が発生した場合でも、必ず `ScreenUpdating = True` や `EventsEnabled = True` を復元するロジックを通る構造にしなければなりません。これらをオフにしたままマクロが異常終了すると、VisioのUIは完全にフリーズし、ユーザーはタスクマネージャーからプロセスを殺すしかなくなります。シニアアーキテクトが書くコードは、どのような異常時であってもシステムの整合性を担保しなければなりません。
—
まとめ：次世代のVisio自動化アーキテクチャへ
今回解説した手法の核心は以下の通りです。
1. `Copy` / `Paste` をコードから永久に追放する：クリップボードはOS全体の共有資源であり、自動化のボトルネックである。
2. `DropMany` による一括生成：複数オブジェクトの配置は1回のCOM境界の往復（Marshaling）で終わらせる。
3. `DrawPolyline` による軽量描画：マスター構造を必要としない描画は、直で座標配列を流し込む。
4. `SetFormulas` による一括更新：プロパティ設定のために `Shape.Cells` をループ内で呼んではならない。
5. UI・イベントの完全サスペンド：処理中はVisioを「無口な計算機」として扱う。
これらを徹底することで、従来数分を要していた千単位の描画処理は数秒からミリ秒のオーダーへと高速化され、システム障害の発生率はゼロに近くなります。レガシー技術と揶揄されがちなVisio VBAですが、内部アーキテクチャの真理を理解して叩けば、現代のエンタープライズ要求にも十分に耐えうる圧倒的なパフォーマンスを発揮するのです。
