こんにちは！今日もVBAの奥深い世界へようこそ。
「自分が作ったスライドを他の人のPCで開いたら、フォントが変わってレイアウトがガタガタになってしまった……」
「外部への提出用PDFを作ったけれど、文字化けしていないか不安で全ページを目視で確認している……」
プレゼンテーション作成の最終盤で、こうした「フォントの文字化け・レイアウト崩れ」のトラブルに頭を悩まされたことはありませんか？
PowerPointには「フォントをファイルに埋め込む」という便利な機能がありますが、実はすべてのフォントが自由に埋め込めるわけではありません。フォント自体に「埋め込み禁止」のライセンス属性が設定されている場合、PowerPointはそれを埋め込むことができず、受け取り側のPCにある別のフォント（代替フォント）で勝手に表示してしまいます。これがレイアウト崩れの真犯人です。
今回は、そんなトラブルを未然に防ぐため、プレゼンテーション内のすべてのフォントをプログラムで事前スキャンし、埋め込み可否やライセンスリスクを自動判定した上で、安全な状態にして保存する「インテリジェント・フォントチェッカー」をVBAで構築します。
一見難しそうに見えるかもしれませんが、オブジェクトの構造さえ紐解けば、あなたにも必ず乗りこなせますよ。「マクロの記録」を卒業し、プロフェッショナルな自動化エンジニアへの第一歩を一緒に踏み出しましょう！
—
1. なぜフォント問題は起きるのか？（本質の理解）
まずは、なぜこのような問題が起きるのか、その仕組みを優しく整理しておきましょう。
フォントの「埋め込みライセンス」という壁
フォントは、デザイナーやフォントメーカーが作った立派な「著作物」です。そのため、フォントファイルの中には「このフォントは他人に渡すファイルに埋め込んで良いか」を示すライセンス情報（属性）があらかじめ書き込まれています。
主に以下の4つのステータスがあります。
1. Installable（制限なし）: 自由に埋め込み可能で、相手のPCにインストールもできます。
2. Editable（編集可能）: 埋め込んだ状態で相手も編集できます。（一般的なビジネス用フォントに多い）
3. Preview/Print（表示/印刷のみ）: 相手は表示と印刷だけができ、スライドの編集はできません。
4. Restricted（埋め込み禁止）: ファイルに埋め込むこと自体が禁止されています。
もしスライド内に Restricted（埋め込み禁止） のフォントが1つでも使われていると、PowerPointを保存する際にエラーが出たり、警告なしで標準フォントに置き換わってしまったりします。
PowerPoint VBAでどう解決するか？
PowerPoint VBAには、現在使用しているフォントが「埋め込み可能かどうか」を直接教えてくれる便利なプロパティ（`Font.IsEmbeddable` のようなもの）が、残念ながら標準では用意されていません。
そこで今回は、以下の実務的アプローチでこの壁を突破します。
[スキャン開始]
│
├── ① スライド内の全テキストを探索し、「実際に使われているフォント」をすべて抽出する
│
├── ② 抽出したフォントを「安全なフォント（標準フォント）」の一覧（ホワイトリスト）と比較する
│
├── ③ ライセンス違反や文字化けリスクのある「非推奨フォント」を検出する
│
├── ④ 検出された場合、ユーザーに警告し、安全なフォント（メイリオ等）へ一括置換する
│
└── ⑤ 埋め込み設定（EmbedTrueTypeFonts = True）を有効にして安全に保存する
この流れを自動化することで、外部配布時の文字化けリスクを「完全にゼロ」にすることができます。
—
2. PowerPointのオブジェクト構造を理解しよう
コードを書く前に、PowerPoint VBAを操る上で最も大切な「オブジェクトの階層構造（親子関係）」を頭に入れておきましょう。ここをクリアすれば、PowerPoint VBAの基本はバッチリです！
PowerPointのテキストは、以下のような「マトリョーシカ（階層構造）」の中にしまわれています。
Presentation (プレゼンテーション全体)
└── Slide (個々のスライド)
└── Shape (図形やテキストボックス)
└── TextFrame (テキストが入る枠)
└── TextRange (文字情報)
└── Runs (フォント設定が切り替わる単位)
なぜ `Runs`（ランズ）が重要なのか？
初心者の多くは `Shape.TextFrame.TextRange.Font.Name` でフォントを取得しようとします。しかし、1つのテキストボックスの中に「日本語（メイリオ）」と「英語（Arial）」が混ざっている場合、この方法では正しいフォント名が取得できず、`Mixed`（混在）というエラー値が返ってきてしまいます。
これを防ぐために、テキストの塊を「フォントが切り替わる単位」に細かく分解してくれる `TextRange.Runs` という仕組みを使います。これを使うことで、混在したフォントも1つ残さず正確にスキャンできるようになります。
—
3. 【実践】極限のフォントスキャン＆自動置換マクロ
それでは、実際に使えるプロ仕様のコードを書いてみましょう。
このマクロは、以下の処理をワンストップで行います。
1. スライド全体から使われているフォントを1つ残さず洗い出す（重複排除）。
2. OS標準ではない「危険なフォント」を検知してレポートする。
3. 危険なフォントが見つかった場合、安全なフォントに一括置換するかどうかをユーザーに確認する。
4. フォント埋め込み設定をオンにして、安全に新規保存する。
準備：Microsoft Scripting Runtime の参照設定
このコードでは、フォント名の重複を綺麗に排除するために `Dictionary` オブジェクトを使用します。
マクロを実行する前に、以下の設定を行ってください。
1. VBAエディタのメニューから [ツール] -> [参照設定] を開きます。
2. [Microsoft Scripting Runtime] にチェックを入れて [OK] を押します。
魂を込めたVBAソースコード
Option Explicit
‘ ==============================================================================
‘ 目的: プレゼンテーション内の全フォントをスキャンし、文字化けリスクを排除して保存する
‘ 開発者: チーフアーキテクト
‘ ==============================================================================
Sub ScanAndSecurePresentationFonts()
Dim pptPres As Presentation
Set pptPres = ActivePresentation
‘ 1. 安全なフォント（ホワイトリスト）の定義
‘ Windows/Macの両方で標準搭載されている、または埋め込みが確実に許可されているフォント
Dim safeFonts As Dictionary
Set safeFonts = New Dictionary
With safeFonts
.CompareMode = TextCompare
.Add “メイリオ”, True
.Add “Meiryo”, True
.Add “遊ゴシック”, True
.Add “Yu Gothic”, True
.Add “ＭＳ Ｐゴシック”, True
.Add “MS PGothic”, True
.Add “ＭＳ ゴシック”, True
.Add “MS Gothic”, True
.Add “ＭＳ Ｐ明朝”, True
.Add “MS PMincho”, True
.Add “Arial”, True
.Add “Calibri”, True
.Add “Times New Roman”, True
.Add “Segoe UI”, True
End With
‘ 2. スライド内の使用フォントを格納する連想配列（重複排除用）
Dim usedFonts As Dictionary
Set usedFonts = New Dictionary
usedFonts.CompareMode = TextCompare
Dim pptSlide As Slide
Dim pptShape As Shape
Dim i As Long
On Error Resume Next ‘ プレースホルダーなどでテキストがない場合のエラーを回避
‘ 3. 全スライド・全シェイプを走査する（フォントスキャン）
For Each pptSlide In pptPres.Slides
For Each pptShape In pptSlide.Shapes
‘ グループ化された図形の中身も走査するための再帰処理、または簡易判定
Call ScanShapeFonts(pptShape, usedFonts)
Next pptShape
Next pptSlide
On Error GoTo 0 ‘ エラーハンドリングを元に戻す
‘ 4. リスクのあるフォント（非推奨フォント）の抽出
Dim riskyFonts As Dictionary
Set riskyFonts = New Dictionary
riskyFonts.CompareMode = TextCompare
Dim fontName As Variant
For Each fontName In usedFonts.Keys
‘ ホワイトリストに含まれていないフォントを「リスクあり」とする
If Not safeFonts.Exists(fontName) And Trim(fontName) <> “” Then
riskyFonts.Add fontName, True
End If
Next fontName
‘ 5. スキャン結果の判定とユーザーへの通知
Dim message As String
Dim response As VbMsgBoxResult
If riskyFonts.Count = 0 Then
MsgBox “素晴らしい！ すべてのフォントが安全（ホワイトリスト内）です。” & vbCrLf & _
“フォントを埋め込んで保存します。”, vbInformation, “スキャン完了”
Else
‘ リスクのあるフォントの一覧を作成
message = “以下のフォントは、他人のPCで表示が崩れたり、埋め込みができない可能性があります：” & vbCrLf & vbCrLf
For Each fontName In riskyFonts.Keys
message = message & “・ ” & fontName & vbCrLf
Next fontName
message = message & vbCrLf & “これらのフォントを安全な「メイリオ」に自動置換しますか？”
response = MsgBox(message, vbYesNoCancel + vbWarning, “警告：非推奨フォントの検出”)
‘ 6. フォントの自動置換処理
If response = vbYes Then
Dim targetFont As Variant
For Each targetFont In riskyFonts.Keys
‘ PowerPointのフォント置換機能（Replaceメソッド）をスマートに実行
pptPres.Fonts.Replace Original:=CStr(targetFont), Replacement:=”メイリオ”
Next targetFont
MsgBox “フォントの置換が完了しました！”, vbInformation, “置換成功”
ElseIf response = vbCancel Then
MsgBox “処理を中断しました。保存は行われません。”, vbExclamation, “中断”
Exit Sub
End If
End If
‘ 7. 安全な設定（フォント埋め込み）を有効にして保存する
Call SavePresentationWithEmbeddedFonts(pptPres)
End Sub
‘ ==============================================================================
‘ サポート関数: シェイプ内のテキストからフォントを抽出する（再帰対応）
‘ ==============================================================================
Private Sub ScanShapeFonts(ByVal shp As Shape, ByRef usedFonts As Dictionary)
Dim i As Long
‘ グループ化された図形の場合は、内部の図形を再帰的にスキャン
If shp.Type = msoGroup Then
Dim subShape As Shape
For Each subShape In shp.GroupItems
Call ScanShapeFonts(subShape, usedFonts)
Next subShape
Exit Sub
End If
‘ テキストフレームを持っているか確認
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
Dim textRng As TextRange
Set textRng = shp.TextFrame.TextRange
‘ Runs（フォント等の書式が同一のセグメント）単位で走査
Dim runRng As TextRange
Dim j As Long
For j = 1 To textRng.Runs.Count
Set runRng = textRng.Runs(j)
Dim fName As String
‘ 日本語フォント（NameFarEast）と英数字フォント（Name）の両方をチェック
fName = runRng.Font.NameFarEast
If fName <> “” And Not usedFonts.Exists(fName) Then
usedFonts.Add fName, True
End If
fName = runRng.Font.Name
If fName <> “” And Not usedFonts.Exists(fName) Then
usedFonts.Add fName, True
End If
Next j
End If
End If
End Sub
‘ ==============================================================================
‘ サポート関数: フォントを埋め込んで別名保存する
‘ ==============================================================================
Private Sub SavePresentationWithEmbeddedFonts(ByVal pres As Presentation)
On Error GoTo ErrorHandler
‘ 1. TrueTypeフォントの埋め込み設定を強制的に「ON」にする
pres.EmbedTrueTypeFonts = True
‘ 2. 保存用のダイアログを表示（ユーザーに保存先を決めてもらう）
Dim fileDialog As Object
Dim selectedPath As String
Set fileDialog = Application.FileDialog(msoFileDialogSaveAs)
With fileDialog
.Title = “フォント埋め込み済みのプレゼンテーションを保存”
.InitialFileName = pres.Path & “\【フォント埋め込み済】” & pres.Name
If .Show = -1 Then
selectedPath = .SelectedItems(1)
‘ 選択されたパスに保存を実行
pres.SaveAs selectedPath
MsgBox “フォントを埋め込んで安全に保存しました！” & vbCrLf & selectedPath, vbInformation, “保存完了”
Else
MsgBox “保存はキャンセルされました。”, vbExclamation, “キャンセル”
End If
End With
Exit Sub
ErrorHandler:
MsgBox “保存中にエラーが発生しました：” & Err.Description, vbCritical, “システムエラー”
End Sub
—
4. コードの徹底解説（ここが上達のポイント！）
このコードには、ただ動くだけでなく、実務で絶対にバグを出さないための「プロの工夫」が散りばめられています。いくつかピックアップして解説しますね。
① `Dictionary`（連想配列）による重複排除
もし100ページのスライドがあって、すべてのページで「メイリオ」が使われていたとします。単純にフォント名を取得していくと、何千回も「メイリオ」がリストに追加されてしまいます。
そこで、`Dictionary` オブジェクトの 「同じキーは2つ登録できない」 という性質を利用しています。
If Not usedFonts.Exists(fName) Then
usedFonts.Add fName, True
End If
この3行により、すでにリストにあるフォントは無視され、最終的に「実際にスライドで使われているユニークなフォント名だけ」のスマートなリストが完成します。
② `NameFarEast` と `Name` のダブルチェック
フォントの設定には、日本語用の `NameFarEast` と、英数字用の `Name` の2種類が存在します。
英語のフォント（Arialなど）と日本語のフォント（メイリオなど）が混在している場合、片方しか見ないと検出漏れが発生してしまいます。このコードでは、その両方を漏れなくキャッチするように設計しています。
③ `Fonts.Replace` メソッドのエレガントさ
リスクのあるフォントが見つかった際、スライドの文字を1つずつ書き換えるのは非常に処理が重く、時間がかかります。
PowerPointに標準搭載されている `Presentation.Fonts.Replace` メソッドを使えば、プレゼンテーション全体で使われている特定のフォントを一瞬で別のフォントへ一括置換できます。非常に高速で、スマートなアプローチです。
—
5. 陥りやすいエラーと対策
マクロを実行したときに「あれ？」と思ったら、以下のポイントをチェックしてみてください。
エラー1:「コンパイルエラー: ユーザ定義型は定義されていません」
- 原因: `Dim safeFonts As Dictionary` の部分でエラーが出ている場合、事前準備で紹介した 「Microsoft Scripting Runtime」の参照設定 ができていません。
- 対策: VBAエディタの [ツール] -> [参照設定] から、該当項目にチェックを入れてください。
エラー2: 埋め込み保存時に「ライセンス制限のため保存できません」とエラーが出る
- 原因: スライド内に、どうしても埋め込みが許可されていないサードパーティ製のフォント（Restricted属性）が残っています。
- 対策: このマクロを実行し、警告画面が出た際に「はい」を選択して、安全なフォント（メイリオ等）へ置換してから保存を実行してください。
—
まとめ：フォントを制する者は、プレゼンを制する
お疲れ様でした！
今回作成した「インテリジェント・フォントチェッカー」は、実務の現場で絶大な効果を発揮します。
特に複数人でスライドを編集したり、社外の様々な環境（Macや古いWindowsなど）にスライドを配布したりするビジネスシーンにおいて、このマクロを一本走らせてから保存するだけで、文字化けによる信頼の低下を防ぎ、プロとしての品質を保証することができます。
一見難しく見えるフォントのライセンスやVBAの階層構造も、順を追って紐解けば、シンプルなロジックの積み重ねであることが分かったかと思います。
ここをクリアすれば、PowerPoint VBAの基本はバッチリですよ！
これからもあなたの業務効率化を、全力で応援しています。また次の記事でお会いしましょう！
