【テクニカル・上級編】【中級者】スライド内の全テキストボックスからフォント名を抽出し、社内標準フォントへ一斉置換してから別名保存するフォントマネージャー – PowerPoint VBA解析バイブル

PowerPoint VBA

2026.10.31

表現の統一を、工学の規律によって制御せよ：フォント・レガシーを駆逐する「Font Manager」の実装論

表現の統一を、工学の規律によって制御せよ：フォント・レガシーを駆逐する「Font Manager」の実装論

プレゼンテーションの美学は、個人のセンスに依存するものではない。それは、組織が定義した「視覚的規律」に従うべきシステムである。

多くの企業において、外部ベンダーから受領した資料や、数年前のレガシーなファイルは、フォントの混沌（カオス）を抱えている。MS Pゴシック、游ゴシック、Arial、あるいは既に廃止されたフォント。これらが混在した資料は、ブランドの信頼性を損なうだけでなく、PDF出力時のレンダリング不備や、印刷時のレイアウト崩れといった、二次的な技術負債を撒き散らす。

本稿では、単なる「フォント置換マクロ」ではない。オブジェクトのライフサイクルを制御し、再帰的な構造を持つスライド内の全要素を走査し、メモリ負荷を最小限に抑えつつ、ブランド標準へと強制的に収束させる、エンジニアリングの観点から設計された「Font Manager」の設計思想と実装を解説する。

1. アーキテクチャの設計思想：なぜ単純なループでは不十分なのか

初心者は、スライドをループし、シェイプをループし、フォントを書き換えるという単純な3重ループを書く。しかし、それは実戦では通用しない。

プロフェッショナルが直面する壁は、以下の3点に集約される。

1. 階層構造の複雑性（Recursive Traversal）:
スライド内のシェイプは、単一のオブジェクトではない。「グループ化されたシェイプ（Group Shapes）」の中にさらにシェイプが存在し、その中にテキストが存在する。この再帰的な構造を正しく走査しなければ、置換漏れが発生する。
2. テキストの多層構造（Text Hierarchy）:
テキストは `Shape` -> `TextFrame` -> `TextRange` -> `Font` という厳格な階層を持つ。さらに、表（Table）やスマートアートといった特殊なコンテナ内にあるテキストは、通常のシェイプ走査では捕捉できない。
3. メモリとオブジェクトのライフサイクル:
大量のスライドを処理する場合、COMオブジェクトの参照が適切に解放されないと、PowerPointのプロセスがメモリを食いつぶし、最終的にクラッシュする。

2. 極限の実装：FontManagerEngine

以下に、これらの課題を解決する堅牢なモジュールを示す。このコードは、再帰的走査、テーブルへの対応、およびエラーハンドリングを統合したものである。

Option Explicit

' ==============================================================================
' Module: FontManagerEngine
' Description: プレゼンテーション内の全テキスト要素を走査し、指定のフォントへ
'              一斉置換を行う。再帰的構造およびテーブル、グループ化に対応。
' Author: Chief Architect
' ==============================================================================

''' <summary>
''' メインエントリーポイント。フォント置換から別名保存までを制御する。
''' </summary>
''' <param name="targetFontName">適用するブランドフォント名</param>
''' <param name="savePath">保存先のフルパス</param>
Public Sub ExecuteFontStandardization(ByVal targetFontName As String, ByVal savePath As String)
    Dim pres As Presentation
    Set pres = ActivePresentation
    
    On Error GoTo ErrorHandler
    
    ' 高速化のための処理：画面更新の停止に近い挙動を模倣（PPTには直接のScreenUpdatingがないため）
    ' 処理中の視覚的ノイズを減らすため、ウィンドウの状態を管理
    Dim originalWindowState As PpWindowState
    originalWindowState = Application.WindowState
    Application.WindowState = ppWindowMinimized

    Debug.Print "--- Standardization Started: " & Now & " ---"

    ' 1. 全スライドの走査開始
    Dim sld As Slide
    For Each sld In pres.Slides
        Debug.Print "Processing Slide: " & sld.SlideIndex
        ProcessSlide sld, targetFontName
    Next sld

    ' 2. 別名保存（既存ファイルの上書きを防ぐため、SaveAsを使用）
    ' 形式はppSaveAsDefault（通常はppSaveAsPresentation）
    pres.SaveAs savePath
    
    MsgDebug "Success: File saved to " & savePath
    
CleanUp:
    Application.WindowState = originalWindowState
    Set pres = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "Critical Error in Standardization: " & Err.Description, vbCritical
    Resume CleanUp
End Sub

''' <summary>
''' スライド内の全シェイプを走査する
''' </summary>
Private Sub ProcessSlide(ByRef sld As Slide, ByVal targetFont As String)
    Dim shp As Shape
    For Each shp In sld.Shapes
        ProcessShape shp, targetFont
    Next shp
End Sub

''' <summary>
''' シェイプの型を判別し、再帰的または直接的にフォントを操作する
''' </summary>
Private Sub ProcessShape(ByRef shp As Shape, ByVal targetFont As String)
    Dim i As Long, j As Long
    Dim subShp As Shape
    
    On Error Resume Next ' 個別のシェイプの不備による停止を防ぐ
    
    Select Case shp.Type
        Case msoGroup
            ' 【再帰】グループ化されたシェイプの中を走査
            For Each subShp In shp.GroupItems
                ProcessShape subShp, targetFont
            Next subShp
            
        Case msoTextBox, msoAutoShape
            ' 通常のテキストボックス・図形
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    ApplyFontToTextRange shp.TextFrame.TextRange, targetFont
                End If
            End If
            
        Case msoTable
            ' 【重要】テーブル内のセルを走査
            For i = 1 To shp.Table.Rows.Count
                For j = 1 To shp.Table.Columns.Count
                    If shp.Table.Cell(i, j).Shape.HasTextFrame Then
                        ApplyFontToTextRange shp.Table.Cell(i, j).Shape.TextFrame.TextRange, targetFont
                    End If
                Next j
            Next i
            
        ' 必要に応じて msoSmartArt 等のケースを追加可能
    End Select
    
    On Error GoTo 0
End Sub

''' <summary>
''' TextRangeに対してフォント置換を適用する。
''' 日本語環境を考慮し、NameFarEast も同時に制御する。
''' </summary>
Private Sub ApplyFontToTextRange(ByRef tr As TextRange, ByVal targetFont As String)
    ' TextRange全体に対して適用
    ' Name: 英数字用フォント
    ' NameFarEast: 日本語（全角文字）用フォント
    tr.Font.Name = targetFont
    tr.Font.NameFarEast = targetFont
    
    ' パフォーマンス最適化: 
    ' 個別の文字レベルでのフォント設定が必要な場合は、ここをループするが、
    ' 全体置換であればRange全体への適用が最も高速かつメモリ効率が良い。
End Sub

Private Sub MsgDebug(ByVal msg As String)
    Debug.Print "[LOG] " & msg
End Sub

3. 技術的深掘り：エンジニアが留意すべき極限の知見

3.1. `Name` と `NameFarEast` の二重制御

Windowsのフォントレンダリングエンジンにおいて、英数字用フォントと日本語（East Asian）用フォントは、内部的に別々のプロパティとして管理されている。
`tr.Font.Name = “Arial”` とだけ記述した場合、日本語部分はシステムのデフォルト（MS Pゴシック等）に残留する。これは「一見統一されているが、拡大するとフォントが混在している」という、極めて質の低い成果物を生む。
必ず `NameFarEast` プロパティも同時に書き換えること。これが、品質を担保する境界線である。

3.2. 再帰アルゴリズムの計算量とスタックオーバーフロー

`msoGroup` に対する再帰処理は、グループの中にグループがある「入れ子構造」に対応するために不可欠である。
実務上のPowerPointファイルにおいて、グループの階層が数百レベルに達することは稀だが、メモリ効率を考慮すれば、`ProcessShape` 内でオブジェクトを `ByRef`（参照渡し）で渡すことは鉄則である。`ByVal` でオブジェクトを渡すと、COMインターフェースのコピーが発生し、不要なオーバーヘッドが生じる。

3.3. テーブル（Table）という「別次元」のコンテナ

多くのエンジニアが陥る罠は、`Shapes` コレクションのループだけでは、テーブル内のテキストを捕捉できないことだ。テーブルは `Shape` オブジェクトの中にありながら、その内部構造は `Rows` と `Columns` という独自の次元を持っている。
本実装では、`Select Case` 文を用いて、`msoTable` を検知した際に専用の二重ループにフォークさせる設計をとっている。

3.4. エラーハンドリングの戦略的配置

`On Error Resume Next` をモジュール全体に適用するのは、プロフェッショナルとして放棄に近い行為である。
本コードでは、個別のシェイプ処理（`ProcessShape`）においてのみ局所的に適用している。これは、「ある一つのシェイプが破損していても、プレゼンテーション全体の処理を中断させない」という、システムとしての可用性（Availability）を確保するための設計判断である。

4. 結論

フォントの統一は、単なる見た目の調整ではない。それは、デジタル資産の整合性を保ち、オートメーションの精度を高めるための、基盤的な「データクレンジング」である。

今回提示したアーキテクチャは、再帰構造、特殊コンテナ、および日本語環境特有のプロパティを網羅している。このレベルのコードを実装できるかどうかが、単なる「VBAが書ける人」と、「システムを設計できるエンジニア」を分かつ境界線となる。

技術は、規律のためにある。