こんにちは。現場の最前線で数多のシステムを組み上げてきたチーフアーキテクトです。
プレゼンテーション資料。それは、あなたの、あるいは企業の「顔」です。しかし、複数のメンバーが作成したスライドを統合したり、外部パートナーから届いた資料を開いたりしたとき、私たちはある絶望に直面します。
「フォントがバラバラだ……」
MS ゴシック、游ゴシック、メイリオ、あるいは謎のフリーフォント。これらが混在した資料は、内容がどれほど素晴らしくても、受け手に「細部へのこだわりの欠如」というノイズを与えてしまいます。
今回は、そんなカオスをワンクリックで解決し、社内標準フォントへと強制的に統一、さらに別名でクリーンに保存する「フォントマネージャー・プロトタイプ」を構築します。
「マクロの記録」を卒業し、PowerPointのオブジェクト構造を掌握する旅へ。ここをクリアすれば、PowerPoint VBAの基本はバッチリですよ。
—
1. PowerPoint VBAの構造を俯瞰する
Excel VBAは「セル」の操作が中心ですが、PowerPoint VBAは「階層構造の探索」が中心です。
1. Presentation (ファイルそのもの)
2. Slide (個々のスライド)
3. Shape (テキストボックス、図形、表、グラフなど)
4. TextFrame (文字を格納する枠)
5. TextRange (実際の文字列とその属性)
今回の任務は、この階層を最下層まで潜り、`Font` オブジェクトを書き換えることにあります。
—
2. 実装：フォントマネージャー・マクロ
以下のコードを、PowerPointのVBE（Alt + F11）で標準モジュールに貼り付けてください。
Option Explicit
‘ ============================================================
‘ 定数定義：社内標準フォントを指定
‘ ============================================================
Private Const TARGET_FONT_NAME As String = “BIZ UDPゴシック” ‘ 日本語フォント
Private Const TARGET_FONT_LATIN As String = “Segoe UI” ‘ 英字フォント
Sub UnifiedFontManager()
Dim sld As Slide
Dim shp As Shape
Dim filePath As String
Dim fileName As String
Dim dotPos As Integer
‘ 1. 処理開始の確認
If MsgBox(“全スライドのフォントを ” & TARGET_FONT_NAME & ” に統一しますか？”, _
vbQuestion + vbYesNo, “フォント一括置換”) = vbNo Then Exit Sub
On Error Resume Next ‘ 万が一のエラーで止まらないよう制御
‘ 2. プレゼンテーション内の全スライドをループ
For Each sld In ActivePresentation.Slides
‘ 3. スライド内の全図形をループ
For Each shp In sld.Shapes
‘ 図形にテキストが含まれているかチェック
ProcessShape shp
Next shp
Next sld
‘ 4. 別名で保存（元のファイルを壊さないための鉄則）
With ActivePresentation
filePath = .FullName
dotPos = InStrRev(filePath, “.”)
‘ ファイル名の末尾に “_Fixed” を付与
fileName = Left(filePath, dotPos – 1) & “_Fixed” & Mid(filePath, dotPos)
.SaveAs fileName
End With
On Error GoTo 0
MsgBox “完了しました！” & vbCrLf & “保存先: ” & fileName, vbInformation
End Sub
‘ ============================================================
‘ 再帰的に図形を処理するサブ関数
‘ グループ化された図形の中までスキャンするために分離
‘ ============================================================
Private Sub ProcessShape(ByRef shp As Shape)
Dim i As Integer
Dim gShp As Shape
‘ A. グループ化されている場合の処理（再帰呼び出し）
If shp.Type = msoGroup Then
For Each gShp In shp.GroupItems
ProcessShape gShp
Next gShp
‘ B. 通常のテキストボックスや図形の場合
ElseIf shp.HasTextFrame Then
If shp.TextFrame.HasText Then
With shp.TextFrame.TextRange.Font
.NameFarEast = TARGET_FONT_NAME ‘ 日本語フォント置換
.Name = TARGET_FONT_LATIN ‘ 英字フォント置換
End With
End If
‘ C. 表（Table）の場合の特殊処理
ElseIf shp.HasTable Then
Dim r As Integer, c As Integer
For r = 1 To shp.Table.Rows.Count
For c = 1 To shp.Table.Columns.Count
With shp.Table.Cell(r, c).Shape.TextFrame.TextRange.Font
.NameFarEast = TARGET_FONT_NAME
.Name = TARGET_FONT_LATIN
End With
Next c
Next r
End If
End Sub
—
3. プロの視点：なぜこのコードなのか？
初学者が陥りやすい罠を、このコードでは3つのテクニックで回避しています。
① `Name` と `NameFarEast` の使い分け
PowerPointのフォント設定には、英字用の `.Name` と、日本語（全角文字）用の `.NameFarEast` が存在します。`Name` だけを変えても、日本語部分が元のまま残ってしまうことが多々あります。両方を明示的に指定するのが、プロの「確実な仕事」です。
② グループ化図形への対応（再帰処理）
スライド上の図形は、しばしば「グループ化」されています。単純なループでは、グループの中にあるテキストボックスを見逃してしまいます。
そこで、`ProcessShape` というサブ関数を作り、図形がグループ（`msoGroup`）なら自分自身をもう一度呼び出す「再帰処理」を行っています。これにより、どんなに深く階層化された図形でも逃さずキャッチできます。
③ 表（Table）オブジェクトの個別対応
PowerPointにおいて、表の中の文字は `HasTextFrame` では判定できません。表は独自の `Table` オブジェクトを持っているため、行（Rows）と列（Columns）で二重ループを回す必要があります。ここをケアしているかどうかが、ツールとしての完成度の分かれ目です。
—
4. 陥りやすいエラーと対策
「実行時エラー: 読み取り専用です」
保存処理（`SaveAs`）の際、既に同名のファイルが開いているとエラーになります。今回のコードではファイル名に `_Fixed` を付与していますが、運用時は「保存ダイアログを表示させる」ように改造すると、より親切なツールになります。
「SmartArtやグラフ内のフォントが変わらない」
SmartArtやグラフの内部構造は非常に複雑です。これらをVBAで完璧に制御しようとするとコードが肥大化するため、中級編としてはまず「テキストボックス」「図形」「表」を確実に押さえるのが正解です。
—
5. 次のステップへの導き
このマクロが動いたとき、あなたはPowerPointの深淵に一歩足を踏み入れたことになります。
「すべてのフォントを変える」ができるようになったら、次は「特定の色（例えば赤色）の文字だけを抽出してリスト化する」といった応用も可能です。オブジェクトの構造さえ掴めば、PowerPointはあなたの意のままに操れるキャンバスへと変わります。
もし、社内の数千枚の資料をPDFへ一括変換したいなら、このコードの最後にある `.SaveAs` の引数を `ppSaveAsPDF` に変えるだけ。自動化の扉は、もう目の前に開いています。
一歩ずつ、確実に。コードに魂を込めていきましょう。応援しています。
