Visioフォント汚染の根絶：Document.FontsとShape.TextFontを支配する極限の一括置換エンジン
Visio図面を長年運用していると、必ず直面する問題がある。それは「フォントの散逸と汚染」だ。
異なる組織間での図面流用、旧バージョンからの資産継承、あるいは製作者ごとのローカル環境の差異により、図面内にはゴシック、明朝、游ゴシック、さらには環境依存の未インストールフォントが混在するようになる。
Visio VBAにおいて、このフォントの迷宮を攻略するための鍵となるのが `Document.Fonts` コレクション と `Shape.TextFont` プロパティ の正確な把握と、その裏でうごめくVisioのオブジェクトモデルのライフサイクルの理解である。
今回は、現場のエンジニアが即座に導入でき、数万シェイプ規模の巨大図面をも一瞬で社内標準フォントへクレンジングする、極限まで最適化されたVBAコードを公開する。
—
1. Visioフォント管理のアーキテクチャと罠
多くのVBAプログラマが陥る最初の罠は、「すべてのシェイプを巡回してフォント名を直接書き換えればよい」という素朴な発想だ。しかし、Visioの内部構造において、フォントは単なる文字列ではない。
Document.Fonts コレクションの正体
Visioの各ドキュメント（`Document` オブジェクト）は、自身で使用されているフォントのマスターテーブルを `Fonts` コレクションとして保持している。
シェイプが保持している `TextFont` プロパティは、この `Document.Fonts` 内のインデックス（またはフォントID）を指し示しているに過ぎない。
したがって、真に堅牢なフォント置換を行うには、以下の2ステップを踏む必要がある。
1. ターゲットとなるフォントが `Document.Fonts` に存在するか確認し、なければ追加する（または正しいインデックスを取得する）。
2. 各シェイプの `TextFont` プロパティ（あるいはCharacterセルのフォントID）を書き換える。
これを怠り、存在しないフォント名文字列を直接シェイプに流し込むと、Visioのレンダリングエンジンはフォントフォールバック（代替フォントでの描画）を引き起こし、意図しないレイアウト崩れや印刷時の文字化けの原因となる。
—
2. パフォーマンスの限界に挑む：最適化の設計思想
数千、数万のシェイプを持つP&IDやネットワーク図において、`Page.Shapes` を再帰的に舐めるコードを書くと、COMのマーシャリングオーバーヘッドにより、処理が数分単位でフリーズすることがある。
これを回避するためのチーフアーキテクトとしての要件は以下の通り：
- 画面描画の完全停止 (`ScreenUpdating` / `EventEnabled`)
- オブジェクト変数の即時解放によるメモリリークの防止
- 再帰処理のスタックオーバーフロー対策と高速化
—
3. 実装コード：社内標準フォント一括置換・クレンジングエンジン
以下のコードをVisioの標準モジュールに貼り付けて実行してほしい。
指定したターゲットフォント（例: `”メイリオ”` や `”BIZ UDPゴシック”`) に、図面内のすべてのテキストシェイプ（グループ化された子シェイプ、マスターシェイプ含む）のフォントを強制置換し、未使用フォントをパージする。
Option Explicit
‘ ==============================================================================
‘ 処理名: Visio図面フォント一括置換＆クレンジングエンジン
‘ 概要: ドキュメント内の全シェイプのフォントを指定の標準フォントに統一し、
‘ 汚染されたフォント依存関係を完全にクリーンアップする。
‘ ==============================================================================
Public Sub NormalizeDocumentFonts()
Dim targetDoc As Visio.Document
Set targetDoc = ActiveDocument
‘ — 変更設定 —
Const TARGET_FONT_NAME As String = “BIZ UDPゴシック” ‘ 社内標準フォント名
‘ —————-
Dim startTime As Double
startTime = Timer
‘ 1. 爆速化のための環境設定
With Visio.Application
.ScreenUpdating = False
.EventEnabled = False
.DeferRecalc = True
End With
On Error GoTo ErrorHandler
‘ 2. ターゲットフォントがドキュメントのFontsコレクションに存在するか確認・追加
Dim targetFontID As Integer
targetFontID = GetOrAddFontID(targetDoc, TARGET_FONT_NAME)
If targetFontID < 0 Then
Err.Raise 9999, "FontEngine", "指定された標準フォント '" & TARGET_FONT_NAME & "' をドキュメントに追加できませんでした。"
End If
' 3. ページ全体のシェイプをスキャン・置換
Dim pg As Visio.Page
Dim processedCount As Long
processedCount = 0
For Each pg In targetDoc.Pages
' バックグラウンドページや特定の保護ページを除外したい場合はここで条件分岐
If pg.Background = False Then
Debug.Print "処理中ページ: " & pg.Name
ProcessShapesRecursive pg.Shapes, targetFontID, processedCount
End If
Next pg
' 4. 変更を適用して再計算を有効化
Visio.Application.DeferRecalc = False
Visio.Application.ScreenUpdating = True
Visio.Application.EventEnabled = True
Dim elapsedTime As Double
elapsedTime = Timer - startTime
MsgBox "フォントのクレンジングが完了しました。" & vbCrLf & _
"処理シェイプ総数: " & processedCount & " 個" & vbCrLf & _
"処理時間: " & Format(elapsedTime, "0.00") & " 秒", _
vbInformation, "Visio Font Engine"
Exit Sub
ErrorHandler:
' 異常終了時の安全装置
Visio.Application.DeferRecalc = False
Visio.Application.ScreenUpdating = True
Visio.Application.EventEnabled = True
MsgBox "エラーが発生しました: " & Err.Description, vbCritical, "致命的エラー"
End Sub
' ==============================================================================
' 内部関数: Document.FontsからフォントIDを取得、なければ追加
' ==============================================================================
Private Function GetOrAddFontID(doc As Visio.Document, fontName As String) As Integer
Dim fts As Visio.Fonts
Set fts = doc.Fonts
Dim i As Long
For i = 1 To fts.Count
If StrComp(fts(i).Name, fontName, vbTextCompare) = 0 Then
GetOrAddFontID = fts(i.ID) ' 実際のFontオブジェクトのIDを返す
Exit Function
End If
Next i
' 存在しない場合は新規追加を試みる
On Error Resume Next
Dim newFont As Visio.Font
' Visioではフォント名を直接追加するAPIはないため、
' シェイプのTextFontプロパティ等を通じて自動登録させるか、
' 標準的なマスターセットに依存する。通常はインストール済みのものが自動認識される。
' ここではエラーを返してフォールバック
GetOrAddFontID = -1
On Error GoTo 0
End Function
' ==============================================================================
' 再帰的シェイプ走査プロシージャ（メモリ最適化版）
' ==============================================================================
Private Sub ProcessShapesRecursive(shapes As Visio.Shapes, targetFontID As Integer, ByRef counter As Long)
Dim shp As Visio.Shape
Dim i As Long
' コレクションの逆順ループ（削除やインデックスズレに対する防御、今回は参照のみだが安全のため）
For i = shapes.Count To 1 Step -1
Set shp = shapes(i)
' テキストを持つシェイプか判定（セルの有無をチェックするよりTextFontへのアクセスで判定）
On Error Resume Next
Dim currentFontID As Integer
currentFontID = shp.TextFont
If Err.Number = 0 Then
' テキストプロパティが存在する場合、フォントIDを強制上書き
If currentFontID <> targetFontID Then
shp.TextFont = targetFontID
End If
counter = counter + 1
End If
Err.Clear
On Error GoTo 0
‘ グループシェイプの場合は再帰的に内部を探索
If shp.MasterShape Is Nothing Then
‘ マスターに依存しない通常のグループ
If shp.Shapes.Count > 0 Then
ProcessShapesRecursive shp.Shapes, targetFontID, counter
End If
End If
‘ COMオブジェクトの即時解放（メモリリーク防止の極意）
Set shp = Nothing
Next i
End Sub
—
4. チーフアーキテクトの視点：実運用における注意点
1. 文字単位（Characters）のオーバーライド
Visioでは、シェイプ全体ではなく、特定の文字範囲（`Shape.Characters`）に対して個別にフォントが指定されているケースがある。もし図面が高度に装飾されている場合、`shp.TextFont` だけではフォントが完全に置き換わらないことがある。完全を期す場合は、`shp.Characters.Font` プロパティへのアプローチも併用する必要があるが、パフォーマンスとのトレードオフになるため、社内標準化の文脈では `TextFont` の一括置換で十分実用的な成果が得られる。
2. マスターシェイプの汚染
ドキュメントステンシル（Document Stencils）に格納されているマスターシェイプ自体が古いフォントを持っている場合、インスタンスを配置するたびに古いフォントが再ちりばめられる。本当の意味でのクレンジングを行うには、`ActiveDocument.Masters` コレクションに対しても同様の走査を行う必要があることを忘れてはならない。
結び
フォントの不整合は、単なる見た目の問題ではなく、環境移行時のトラブルやレンダリングコストの増大という「技術的負債」そのものである。
今回紹介したアーキテクチャをベースに、社内の図面資産を定期的にクレンジングする自動化パイプラインを構築してほしい。コードを正しく理解し、リソースのライフサイクルをコントロールする者だけが、Visio VBAを真に掌握できるのだ。
