プレゼン資料の「フォント汚染」を根絶せよ：堅牢なフォントマネージャーの設計思想と実装
外部ベンダーから納品された資料、あるいは数年前の担当者が遺したレガシーなPowerPointファイル。それらを開いた瞬間、あなたの目に飛び込んでくるのは、バラバラなフォント、不自然な文字間隔、そしてブランドアイデンティティを損なう「フォントの不一致」ではないだろうか。
これらを一つずつ手作業で修正するのは、エンジニアリングとは呼べない。しかし、単に「全テキストを置換する」という安易なマクロを書けば、グループ化された図形を見落としたり、特定の箇所だけフォントが変わらずに残ったりといった、中途半端な成果物を生むことになる。
本記事では、単なる「置換マクロ」の枠を超えた、プロダクション環境に耐えうる「フォントマネージャー」の設計手法を伝授する。
1. アマチュアとプロフェッショナルの境界線：設計思想
多くの開発者が陥る罠がある。それは「スライド内のShapeをループで回せば済む」という短絡的な思考だ。プロフェッショナルは、以下の3つの観点から設計を組み立てる。
A. 再帰的探索（Recursive Traversal）の必要性
PowerPointのShapeオブジェクトは、単なる平坦なリストではない。`GroupShape` の中にさらに `Shape` が存在する階層構造を持っている。単純な `For Each shp In sld.Shapes` では、グループ化された中のテキストボックスは「不可視」となる。これを突破するには、再帰関数による探索が不可欠だ。
B. TextRangeの粒度（Granularity）
一つのテキストボックス内に、複数のフォントが混在しているケースは多々ある。`TextFrame.TextRange.Font.Name` を書き換えるだけでは、文字単位の細かな書式設定（Runs）を破壊する恐れがある。我々が目指すのは、「既存の書式（サイズや色）を維持したまま、フォント名だけを正確に射抜く」設計だ。
C. 冪等性と副作用の制御
「別名保存」は絶対条件だ。元のファイルを破壊するマクロは、業務自動化ツールとしては欠陥品である。また、ファイル保存時のエラー（書き込み権限不足、同名ファイルが存在するなど）を想定した例外処理が、システムの信頼性を決定づける。
2. プロダクション・コード：フォント・正規化エンジン
以下に、私が設計した堅牢なコード例を示す。このコードは、再帰的な探索、テキストのRun単位での走査、そして安全な別名保存を実装している。
Option Explicit
' =================================================================
' 設定セクション：ここを社内標準に合わせて変更する
' =================================================================
Private Const TARGET_FONT_NAME As String = "Yu Gothic UI" ' 統一したいフォント名
Private Const SAVE_SUFFIX As String = "_Standardized" ' 保存時の接尾辞
' =================================================================
' メインルーチン：フォント正規化プロセスを実行
' =================================================================
Public Sub ExecuteFontNormalization()
Dim pptPres As Presentation
Dim targetPath As String
Dim newPath As String
Dim slideIdx As Integer
Set pptPres = ActivePresentation
' 1. ユーザーへの確認（誤操作防止）
If MsgBox("現在のプレゼンテーションの全フォントを「" & TARGET_FONT_NAME & "」に統一し、別名で保存しますか？", _
vbQuestion + vbYesNo, "フォントマネージャー実行") <> vbYes Then Exit Sub
On Error GoTo ErrorHandler
' 2. 全スライドの走査
Debug.Print "--- Process Started: " & Now & " ---"
For Each sld In pptPres.Slides
Debug.Print "Processing Slide: " & sld.SlideIndex
ProcessSlideShapes sld.Shapes
Next sld
' 3. 別名保存の準備
targetPath = pptPres.FullName
If targetPath = "" Then
MsgBox "ファイルを保存してから実行してください。", vbCritical
Exit Sub
End If
' 拡張子を除いたパスを作成
newPath = Left(targetPath, InStrRev(targetPath, ".") - 1) & SAVE_SUFFIX & _
Mid(targetPath, InStrRev(targetPath, "."))
' 4. 保存実行 (SaveCopyAs を使用して元のインスタンスへの影響を最小化)
pptPres.SaveCopyAs newPath
MsgBox "完了しました！" & vbCrLf & "保存先: " & newPath, vbInformation, "Success"
Exit Sub
ErrorHandler:
MsgBox "致命的なエラーが発生しました。" & vbCrLf & _
"Error No: " & Err.Number & vbCrLf & _
"Description: " & Err.Description, vbCritical, "System Error"
End Sub
' =================================================================
' スライド内のShapeを再帰的に処理する関数
' =================================================================
Private Sub ProcessSlideShapes(ByRef shpCollection As Shapes)
Dim shp As Shape
For Each shp In shpCollection
' グループ化されている場合は再帰呼び出し
If shp.Type = msoGroup Then
ProcessSlideShapes shp.GroupItems
Else
' テキストを持つShapeか判定
If HasText(shp) Then
ReplaceFontInShape shp
End If
End If
Next shp
End Sub
' =================================================================
' テキストボックス内のフォントをRun単位で精密に置換する
' =================================================================
Private Sub ReplaceFontInShape(ByRef shp As Shape)
Dim tr As TextRange
Dim i As Integer
Set tr = shp.TextFrame.TextRange
' TextRange.Runs を走査することで、文字ごとの書式（フォント違い）を個別に制御
' これにより、文字サイズや色は維持しつつ、フォント名だけを確実に変更できる
For i = 1 To tr.Runs.Count
tr.Runs(i).Font.Name = TARGET_FONT_NAME
' アジア言語フォント（日本語フォント）も明示的に指定
tr.Runs(i).Font.NameFarEast = TARGET_FONT_NAME
Next i
End Sub
' =================================================================
' Shapeがテキストを保持しているか判定するヘルパー関数
' =================================================================
Private Function HasText(ByRef shp As Shape) As Boolean
On Error Resume Next
HasText = (shp.TextFrame.HasText = msoTrue)
On Error GoTo 0
End Function3. アーキテクトの深掘り：なぜこの書き方なのか
このコードが、なぜ「コピペで動く」だけでなく「現場で使える」のか。その技術的根拠を解説する。
「Runs」へのこだわり
多くの初心者は `shp.TextFrame.TextRange.Font.Name = “…”` と書く。しかし、これでは「そのテキストボックス内のすべての文字が、一律の書式に上書きされる」リスクがある。例えば、「重要」という文字だけ赤字で大きくしている場合、全体置換を行うと書式が崩れる可能性がある。
`TextRange.Runs` をループすることで、書式が変わる境界線ごとにオブジェクトを捉え、フォント名だけをピンポイントで狙い撃つ。これがプロの精密さだ。
再帰構造の設計
`ProcessSlideShapes` 内で `If shp.Type = msoGroup` を判定し、自分自身（`ProcessSlideShapes`）を呼び出す設計は、ツリー構造を探索する際の定石だ。これにより、グループの中にグループがある「入れ子構造」であっても、末端のテキストボックスまで確実に到達できる。
`SaveCopyAs` の選択
`SaveAs` を使うと、現在開いているPowerPointのファイル自体が新しいファイルに切り替わってしまう。これは、マクロ実行後に「あれ、元のファイルはどこへ行った？」という混乱を招く。`SaveCopyAs` を使えば、現在の作業状態を維持したまま、バックグラウンドで複製を作成・保存できる。ユーザー体験（UX）の観点から、この選択は極めて重要だ。
4. 実務への導入アドバイス
このツールを組織に展開する際は、以下の点に留意せよ。
1. フォントの存在確認: `TARGET_FONT_NAME` に指定するフォントが、実行環境（全社員のPC）にインストールされていることを前提とすること。インストールされていない場合、PowerPointは代替フォントを勝手に割り当てるが、それは「ブランド統一」の目的から外れる。
2. データベース連携の拡張: もし、複数のブランド（製品A用、製品B用など）がある場合は、`Const` ではなく、Excelファイルや外部のJSON/CSVからフォント名を取得するように設計を変更せよ。
3. ログの重要性: 大規模な処理を行う場合、どのスライドでエラーが起きたかを記録するログ出力機能を追加すると、保守性が飛躍的に向上する。
結びに
自動化の本質は、単に「速くすること」ではない。「人間が介在すべきでない、退屈でミスが起きやすい作業から人間を解放すること」にある。
このフォントマネージャーは、その哲学に基づいた設計となっている。技術の表面をなぞるのではなく、オブジェクトの構造とライフサイクルを理解したコードを書くこと。それが、伝説的なエンジニアへの第一歩だ。
