【Visio VBA極限解説】図面全体のフォント地獄からの脱却：非標準フォントを駆逐する一括置換・クレンジング自動化
こんにちは。チーフアーキテクトの私だ。
大規模なネットワーク図やフロアレイアウト、UML図面などを組織横断で運用していると、必ずと言っていいほど直面する問題がある。それは「フォントの混濁（カオス）」だ。
外部ベンダーから納品された図面、退職者が残したレガシー図面、あるいはコピペを繰り返した無秩序なドキュメント。これらを開くと、Meiryo UI、MS Ｐゴシック、Arial、さらには開発環境にインストールされていない謎のフォントが混在し、図面の美観とプロフェッショナルな品質を完全に破壊している。
手動でシェイプを選択し、リボンからフォントをポチポチ変える？ 200個もシェイプがあれば発狂ものだし、グループ化されたネストの奥底にあるテキストは見事にスルーされるだろう。
今回は、Visioのオブジェクトモデルの深淵である `Shape.TextFont`プロパティ と `Document.Fonts`コレクション の関係性を完全に理解し、図面全体のフォントを一網打尽にクレンジング・置換するプロダクション品質のマクロを授けよう。
—
1. なぜ「普通のVBAコード」ではフォント置換に失敗するのか？
多くの初学者が陥る罠がこれだ。「すべてのシェイプをループして、`Font`プロパティ書き換えればいいんでしょ？」と安易に以下のようなコードを書く。
‘ 【アンチパターン】絶対にやってはいけない例
Dim shp As Visio.Shape
For Each shp in ActivePage.Shapes
shp.Cells(“Font”).Formula = “””Meiryo””” ‘ 動かない、あるいはエラーになる
Next shp
敗因の分析
1. グループ化の壁: `ActivePage.Shapes` はトップレベルのシェイプしか取得しない。グループ内の子シェイプ、コンポーネント内のテキストは完全に無視される。
2. 文字単位（Character Run）のオーバーライド: Visioのシェイプは、シェイプ全体に対してフォントを指定できるだけでなく、「テキストの中の特定の部分（文字単位）」に異なるフォントを強制適用できる（`Characters`オブジェクト）。シェイプ全体のプロパティを変えても、文字単位のローカル書式が設定されている場合、そちらが優先されフォントが変わらない。
3. `Document.Fonts`の概念不在: Visioのフォントは文字列で保持されているのではなく、ドキュメントに登録されたフォントインデックス（ID）で管理されている。この実体を理解していないと、存在しないフォント名を設定して実行時エラーを引き起こす。
真に堅牢なツールを作るには、「再帰的な全シェイプ走査」と「文字単位（Characters）の強制上書き」の2つを同時に実装しなければならない。
—
2. アーキテクチャ設計：堅牢なクレンジングエンジンの要件
今回構築するマクロの要件を定義する。
- 完全網羅性: ページ内の通常シェイプだけでなく、グループ内のネストされたシェイプ、マスター、背景ページに至るまで再帰的に走査する。
- 二段構えの置換: シェイプ全体のフォントプロパティ（`TextFont`等）と、文字単位の書式（`Characters`）の双方をターゲットにする。
- 安全なフォント検証: 変更先のフォントが対象ドキュメントの `Document.Fonts` に存在するか、あるいは安全に追加できるかを確認する。
- 実行ログの出力: どのシェイプのどのテキストのフォントが何から何へ変わったのかをイミディエイトウィンドウに詳細に出力する。
—
3. プロダクションコード：フォント一括置換・クレンジングマクロ
以下のコードをVisioのVBAエディタ（`Alt + F11`）の標準モジュールに貼り付けてほしい。実務でそのまま使える、エラーハンドリングと再帰処理を網羅した最高峰のコードだ。
Option Explicit
‘ ==============================================================================
‘ 処理名: 組織標準フォント一括置換・クレンジングエンジン
‘ 概要 : 図面内の全ページ・全シェイプ（グループ内含む）を走査し、
‘ 指定したターゲットフォントを社内標準フォントへ強制置換する。
‘ ==============================================================================
Public Sub CleanAndReplaceFonts()
‘ — 設定エリア —
Const TARGET_FONT_NAME As String = “Meiryo” ‘ 適用したい社内標準フォント名
Const SEARCH_FONT_NAME As String = “” ; 空欄(“”)の場合は「全フォントを対象」、特定したい場合は “MS Ｐゴシック” 等を指定
‘ ——————
Dim targetFontID As Integer
targetFontID = GetOrAddFontID(ActiveDocument, TARGET_FONT_NAME)
If targetFontID < 0 Then
MsgBox "指定された標準フォント '" & TARGET_FONT_NAME & "' をドキュメントに追加できませんでした。", vbCritical
Exit Sub
End If
Dim totalProcessedCount As Long
totalProcessedCount = 0
' 処理開始の計測
Dim startTime As Double
startTime = Timer
' ドキュメント内の全ページを走査（通常ページ ＋ 背景ページ）
Dim vPag As Visio.Page
For Each vPag in ActiveDocument.Pages
Debug.Print "--- ページ処理開始: " & vPag.Name & " ---"
Dim vShp As Visio.Shape
For Each vShp in vPag.Shapes
ProcessShapeRecursive vShp, SEARCH_FONT_NAME, targetFontID, totalProcessedCount
Next vShp
Next vPag
' 完了通知
Dim elapsedTime As Double
elapsedTime = Timer - startTime
MsgBox "フォントのクレンジングが完了しました！" & vbCrLf & _
"処理シェイプ総数: " & totalProcessedCount & " 個" & vbCrLf & _
"処理時間: " & Format(elapsedTime, "0.00") & " 秒", vbInformation, "完了"
End Sub
' ==============================================================================
' 内部プロシージャ: シェイプを再帰的に走査し、テキストフォントを置換する
' ==============================================================================
Private Sub ProcessShapeRecursive(ByVal shp As Visio.Shape, ByVal searchFont As String, ByVal newFontID As Integer, ByRef counter As Long)
On Error GoTo ErrorHandler
' 1. テキストを持っているシェイプか判定
If shp.Characters.Text <> “” Then
Dim chars As Visio.Characters
Set chars = shp.Characters
‘ シェイプ全体のフォント名を取得（セル経由または文字プロパティ）
‘ ※VisioのCellsU(“Char.Font”)等で直接制御するアプローチ
On Error Resume Next
Dim currentFontName As String
currentFontName = shp.Cells(“Char.Font[1]”).ResultStr(“”)
On Error GoTo ErrorHandler
‘ 検索対象フォントが指定されている場合、一致するかチェック（空欄なら無条件）
Dim executeReplace As Boolean
executeReplace = False
If searchFont = “” Then
executeReplace = True
ElseIf StrComp(currentFontName, searchFont, vbTextCompare) = 0 Then
executeReplace = True
End If
If executeReplace Then
‘ 文字単位（Characters）のフォントを一括置換
‘ 文字列全体を選択してフォントIDを上書きする
chars.Begin = 0
chars.End = Len(chars.Text)
‘ セルプロパティ経由での書き換え（最も確実）
If shp.CellExists(“Char.Font”, Visio.visExistsAnywhere) Then
shp.Cells(“Char.Font”).FormulaU = newFontID
counter = counter + 1
Debug.Print ” [置換成功] ShapeID: ” & shp.ID & ” (” & shp.Name & “) Text: ” & Left(Replace(chars.Text, vbCrLf, ” “), 20)
End If
End If
End If
‘ 2. グループシェイプの場合は、内部の子シェイプを再帰的に処理
If shp.Type = Visio.visTypeGroup Then
Dim subShp As Visio.Shape
Dim i As Long
For i = 1 in shp.Shapes.Count
Set subShp = shp.Shapes(i)
ProcessShapeRecursive subShp, searchFont, newFontID, counter
Next i
End If
Exit Sub
ErrorHandler:
‘ 個別シェイプのエラーで全体を止めない設計
Debug.Print ” [エラー発生] ShapeID: ” & shp.ID & ” 理由: ” & Err.Description
Resume Next
End Sub
‘ ==============================================================================
‘ ユーティリティ: Document.Fontsから指定フォントのIDを取得、なければ追加する
‘ ==============================================================================
Private Function GetOrAddFontID(ByVal doc As Visio.Document, ByVal fontName As String) As Integer
Dim i As Long
Dim fontObj As Visio.Font
‘ 既存のドキュメントフォントコレクションを走査
For i = 1 To doc.Fonts.Count
Set fontObj = doc.Fonts(i)
If StrComp(fontObj.Name, fontName, vbTextCompare) = 0 Then
GetOrAddFontID = fontObj.ID
Exit Function
End If
Next i
‘ ドキュメントに存在しない場合、追加を試みる
On Error GoTo AddError
Dim newFont As Visio.Font
Set newFont = doc.Fonts.Add(fontName)
GetOrAddFontID = newFont.ID
Exit Function
AddError:
GetOrAddFontID = -1
End Function
—
4. コードの技術的ポイントとアーキテクチャの解説
今回のコードでチーフアーキテクトとして特にこだわった実装上のキモを解説しよう。
① `Document.Fonts.Add` によるフォントの安全なバインド
Visioの図面ファイル（`.vsd` / `.vsdx`）は、使用されているフォントのメタデータを内部のフォントテーブルに保持している。単に文字列で `”Meiryo”` と突っ込むだけでは、Visioの描画エンジンが内部IDを解決できずにデフォルトフォントにフォールバックすることがある。
`GetOrAddFontID` 関数は、対象ドキュメントの `Fonts` コレクションに目的のフォントが存在するかをまず確認し、なければプログラム側で安全にインデックス（ID）を生成・取得する。これにより、どの環境で実行しても確実なフォント適用を担保している。
② 再帰的アルゴリズム（`ProcessShapeRecursive`）による完全網羅
Visioのグループ化はネスト（入れ子構造）の深さに制限がない。例えば「フロア全体のグループ」の中に「オフィスの島グループ」があり、その中に「机のシェイプ」があるといった構造だ。
単純な `For Each shp In Page.Shapes` では最上位のグループしか捕まえられない。本コードでは `shp.Type = Visio.visTypeGroup` を検知した瞬間に自分自身を再帰呼び出し（Recursive Call）する設計にしており、どれほど深くネストされたテキストであっても漏らさず捕捉する。
③ エラーハンドリングの分離（レジリエンス設計）
図面の中には、保護されたシェイプや、マスターの仕様上テキストセルの書き換えがロックされている特殊なオブジェクトが存在する。ここでマクロが全体停止（Run-time Error）してはツールとして失格だ。
`On Error GoTo ErrorHandler` によって、個別のシェイプの書き込み権限エラーや予期せぬ例外はイミディエイトウィンドウにログとして逃がし、処理そのものは次のシェイプへ継続させる「高いレジリエンス（復元力）」を持たせている。
—
5. 実運用における注意点とデータベース連携への発展
このマクロを企業の業務自動化パイプラインに組み込む場合のベストプラクティスを共有しよう。
1. バックアップの義務化:
プログラムを実行する前には、必ず `ActiveDocument.SaveAs` などで別名バックアップを取るか、スクリプトの冒頭で自動バックアップを保存するロジックを挟むこと。フォント置換はドキュメントのバイナリ構造を大きく書き換えるため、戻せないリスクを排除すべきだ。
2. マスターシェイプ（Document.Masters）のクレンジング:
今回のコードは「配置されたシェイプ」を対象にしているが、ドキュメントのステンシル（マスター）側に埋め込まれたシェイプのフォントが古い場合、新しいシェイプをドラッグ＆ドロップした瞬間に古いフォントが再発する。完全なクレンジングを目指す場合は、`ActiveDocument.Masters` コレクションに対しても同様の再帰処理を適用すると完璧だ。
3. 外部データベース/設定ファイル連携:
「どの図面をどのフォントに置き換えるか」というルールをハードコーディングせず、社内のSharePointリストやSQL Server、あるいはJSON設定ファイルから読み込ませるラッパーを書くことで、全社展開可能な「図面標準化マイクロサービス（VBA版）」へと昇華させることができる。
総括
VisioのVBA開発において、オブジェクトモデルの「階層構造」と「セルの概念」を理解しているかどうかで、書くコードの質は天と地ほどの差が出る。
今回紹介したフォントクレンジングエンジンは、単なる便利スクリプトの枠を超え、あなたの組織の図面資産の品質を担保する強力な武器となるはずだ。
手作業による疲弊をエンジニアリングで駆逐せよ。健闘を祈る。
