こんにちは！ Visio VBAの世界へようこそ。
マクロの記録ボタンを押して「動いたはいいけれど、中身が全然読めない……」と頭を抱えていませんか？ 大丈夫、みんな最初はそこからスタートします。
今回は、実務で本当によくある「図面ごちゃ混ぜフォント問題」を華麗に解決するテーマを取り上げます。
他部署から集まった図面や、バラバラの資料をコピペして作った図面って、気がつくと「メイリオ」「MS Pゴシック」「Arial」「游ゴシック」……と、フォントがカオス状態になっていますよね。これを手作業で直すのは、もはや拷問です。
今回は、Visioの心臓部である`Document.Fonts`コレクションと`Shape.TextFont`プロパティを完全に手なづけ、図面全体のフォントを一発でクレンジング・統一する「プロの自動化コード」を一緒に作っていきましょう。
ここをクリアすれば、Visio VBAのオブジェクトモデルの基本はバッチリです！ 一緒にマスターしていきましょうね。
—
1. Visioオブジェクトモデルの基本：ピラミッド構造を理解しよう
コードを書く前に、Visioの世界がどういう構造になっているかを知る必要があります。Visio VBAは、以下のような「マトリョーシカ（あるいはピラミッド）」構造をしています。
[Application] （Visioアプリ全体）
└─ [Document] （開いている図面ファイル）
├─ [Page] （図面の中のページ）
│ └─ [Shape] （ページに配置された図形・テキスト）
└─ [Fonts] （その図面で使えるフォントのリスト）
フォントを置換するということは、「Documentが持っているフォントの辞書（Fonts）」を確認し、「各PageにあるShape」がどのフォントを使っているか（TextFont）を覗き見して、一気に書き換えるという作業になります。
—
2. 今回のキモ：`Document.Fonts` と `Shape.TextFont` の関係
Visioの図面（Document）は、その図面内で使われているフォントの名前とIDの対応表（コレクション）を裏側で持っています。
- `ActiveDocument.Fonts`: この図面が知っているフォントの全リスト。
- `Shape.TextFont`: シェイプが現在「何番のフォントID」を使っているかを示すプロパティ。
厄介なことに、Visioのシェイプは「フォント名（文字列）」ではなく「フォントID（整数）」でフォントを管理しています。だから、「社内標準の『メイリオ』に変えたい！」と思ったら、まず「『メイリオ』のIDは何番だっけ？」と`Document.Fonts`に聞きに行く必要があるんです。
ここが、多くの人が躓くポイント。「名前で指定させてよ！」と叫びたくなりますが、この仕組みさえ分かれば怖くありません。
—
3. 実践！フォント一括置換・クレンジングマクロ
お待たせしました。実務でそのままコピペして使える、極上のクレンジングコードをプレゼントします。
このコードは、「図面内のすべてのシェイプをスキャンし、指定した旧フォント（またはすべてのフォント）を、社内指定の美しき新フォントに強制統一する」ものです。
Sub CleanAndReplaceFonts()
‘ =====================================================================
‘ 目的: 図面全体のフォントをスキャンし、指定フォントを指定フォントへ一括置換する
‘ 開発者: 優しい先輩エンジニア
‘ =====================================================================
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim targetFontName As String
Dim newFontName As String
Dim newFontID As Integer
Dim replacedCount As Long
‘ — 設定エリア —
targetFontName = “” ‘ 空欄(“”)なら「すべてのフォント」を対象。特定したい場合は “MS Pゴシック” などと指定
newFontName = “メイリオ” ‘ あなたの社内標準フォント（例：メイリオ、游ゴシックなど）
‘ ——————
On Error GoTo ErrorHandler
‘ 1. 新しいフォントのIDをDocument.Fontsから取得する
newFontID = GetFontID(ActiveDocument, newFontName)
If newFontID = -1 Then
MsgBox “指定された新しいフォント ‘” & newFontName & “‘ がこの図面に見つかりません。”, vbCritical, “エラー”
Exit Sub
End If
replacedCount = 0
‘ 2. 図面内のすべてのページをループする
For Each vsoPage In ActiveDocument.Pages
‘ 3. 各ページ内のすべてのシェイプを再帰的にスキャンする（グループ化された図形も考慮）
For Each vsoShape in vsoPage.Shapes
Call ProcessShapeRecursive(vsoShape, targetFontName, newFontID, replacedCount)
Next vsoShape
Next vsoPage
‘ 4. 完了報告
MsgBox “フォントのクレンジングが完了しました！” & vbCrLf & _
“変更されたテキスト要素の数: ” & replacedCount & “件”, vbInformation, “完了”
Exit Sub
ErrorHandler:
MsgBox “予期せぬエラーが発生しました: ” & Err.Description, vbCritical, “致命的なエラー”
End Sub
‘ =====================================================================
‘ サブルーチン: シェイプを再帰的に巡回し、フォントを書き換える
‘ =====================================================================
Private Sub ProcessShapeRecursive(ByVal shp As Visio.Shape, ByVal targetName As String, ByVal newID As Integer, ByRef count As Long)
On Error Resume Next
‘ シェイプにテキストが存在し、かつフォントプロパティにアクセスできる場合
If shp.CellExists(“Char.Font”, 0) Then
‘ targetNameが空欄、もしくは現在のフォント名と一致する場合に置換
If targetName = “” Or shp.Characters.CharProperties(visCharacterFont) = targetName Then
shp.CellsU(“Char.Font”).FormulaU = newID
count = count + 1
End If
End If
‘ もしシェイプが「グループ」だったら、中のパーツ（子シェイプ）も掘り下げる
If shp.Type = visTypeGroup Then
Dim subShp As Visio.Shape
For Each subShp In shp.Shapes
Call ProcessShapeRecursive(subShp, targetName, newID, count)
Next subShp
End If
On Error GoTo 0
End Sub
‘ =====================================================================
‘ 関数: フォント名からVisioのフォントID（整数）を逆引きする
‘ =====================================================================
Private Function GetFontID(ByVal doc As Visio.Document, ByVal fontName As String) As Integer
Dim f As Visio.Font
GetFontID = -1 ‘ 見つからない場合の初期値
For Each f In doc.Fonts
If StrComp(f.Name, fontName, vbTextCompare) = 0 Then
GetFontID = f.Index
Exit Function
End If
Next f
End Function
—
4. コードのここがポイント！ 押さえておきたい3つの知見
このコードには、現場で培った「ドハマり回避の知見」が詰まっています。初学者のうちに絶対に知っておいてほしいポイントを3つ解説します。
① グループ化された図形（`visTypeGroup`）の罠
Visioで図形をグループ化すると、そのグループは「親」、中の図形は「子」という親子関係になります。
通常のループ（`For Each vsoShape In vsoPage.Shapes`）だけだと、グループの「外側」しか見ず、「中身」のテキストを見落とします。
そのため、今回のコードでは `ProcessShapeRecursive` という関数を作り、グループを見つけたら自らを呼び出して（再帰処理）、奥の奥まで漏れなくフォントを捜索・変更するようにしています。ここはエンジニアとしての腕の見せ所です。
② セルの直接操作：`CellsU(“Char.Font”).FormulaU = newID`
Visioのシェイプが持つプロパティは、背後で「シェイプシート（ShapeSheet）」という表計算のようなデータベースと繋がっています。
フォントを変えるときは、単に `shp.TextFont = …` と書くよりも、`Char.Font` セルに直接数式（FormulaU）としてフォントIDを流し込む方が、Visioの描画エンジンがバグりにくく、圧倒的に堅牢に動作します。
③ 安全なエラーハンドリング（`On Error Resume Next`）
複雑な図面には、テキストを持たない特殊なコネクタや、プロパティを保護されたステンシル図形が混ざっていることがあります。これらに無理やりフォントを変更させようとすると、VBAは容赦なく「実行時エラー」を吐いて止まります。
そのため、シェイプ内部のプロパティを触る瞬間だけ `On Error Resume Next` を使い、「触れなかったやつはスルーして次に行く」という大人の余裕を持たせることが、実務マクロの鉄則です。
—
おわりに：あなたの図面資産を美しく保つために
今回は、`Shape.TextFont` と `Document.Fonts` を連動させて、図面全体のフォントを一括置換するマクロを解説しました。
「マクロって難しそう……」と思っていたかもしれませんが、オブジェクトの構造を理解し、一歩ずつコードを組み立てていけば、手作業で何時間もかかっていたクレンジング作業をわずか1秒で終わらせることができます。これがプログラミングの醍醐味であり、エンジニアの特権です。
ぜひ、あなたの手元の「フォントがバラバラの絶望的な図面」でこのマクロを試してみてください。一瞬で美しく整った瞬間、きっと感動するはずです。
ここをクリアしたあなたなら、もうVisio VBAの基本はバッチリです！ 次回の応用編もお楽しみに。それでは、快適な自動化ライフを！
