Notice: Function _load_textdomain_just_in_time was called incorrectly. Translation loading for the google-analytics-for-wordpress domain was triggered too early. This is usually an indicator for some code in the plugin or theme running too early. Translations should be loaded at the init action or later. Please see Debugging in WordPress for more information. (This message was added in version 6.7.0.) in /home/xs182025/consulting-campus.site/public_html/wp-includes/functions.php on line 6114
本記事では、パワポのファイルの全フォントを一括変更する方法をご紹介します。今回の方法ではマクロ・VBAのコードを使用しており、グループ化されたシェイプやテーブル、チャートなど、全スライド・全オブジェクトのフォントを確実に一括変更し新しいフォントを設定することができます。マクロやVBAに馴染みがない方でもコピペだけで1発で使用できるコードとなっていますのでぜひご活用ください。 | CONSULTING CAMPUS

【PowerPoint】パワポ内の全フォントを1発で一括変更する

ファイルのフォントを1発で一括変更する VBA
この記事は約15分で読めます。
スポンサーリンク

本記事では、パワポのファイルの全フォントを一括変更する方法をご紹介します。今回の方法ではマクロ・VBAのコードを使用しており、グループ化されたシェイプやテーブル、チャートなど、全スライド・全オブジェクトのフォントを確実に一括変更し新しいフォントを設定することができます。マクロやVBAに馴染みがない方でもコピペだけで1発で使用できるコードとなっていますのでぜひご活用ください。

  • パワポのファイル内のフォントを一括で変更したい
本記事で実装する処理
フォントの一括変更
スポンサーリンク

結論: パワポのファイル内の全フォントを一括変更する方法

下記のVBAをコードを実行し、新たに設定したいフォント名を入力するだけでファイルのあらゆるフォントが一括変更されます。これには、チャート・グラフや、グループ化されたオブジェクト、スマートアートなどが含まれるため、これまでエラーが起きたりフォントが変わらなかった人も試してみてください。

コードを実行するためにはビジュアルエディタでコピペから実行してください。その後、フォント名を尋ねるダイアログに任意のフォントを入力することでファイル内のすべてのフォントを指定したフォントに設定できます。

フォント名を尋ねるダイアログ
Sub ChangeFontInAllShapes()
    Dim pptPres As Presentation
    Dim pptSlide As Slide
    Dim pptShape As Shape
    Dim newFontName As String
    Dim isValidFont As Boolean
    Dim i As Integer
    
    ' ユーザーにフォント名を尋ねる
    newFontName = InputBox("フォント名を入力してください:")
    
    ' アクティブなプレゼンテーションを取得
    Set pptPres = Application.ActivePresentation
    
    ' すべてのスライドをループ
    For Each pptSlide In pptPres.Slides
        ' スライド内のすべてのシェイプをループ
        For Each pptShape In pptSlide.Shapes
            ' シェイプのフォントを変更する再帰関数を呼び出す
            ChangeFontInShape pptShape, newFontName
        Next pptShape
    Next pptSlide
    
    MsgBox "フォント変更が完了しました。"
End Sub

Sub ChangeFontInShape(shp As Shape, newFontName As String)
    Dim i As Integer
    Dim subShp As Shape

    With shp
        If .Type = msoGroup Then
            ' シェイプがグループの場合、グループ内のすべてのシェイプをイテレート
            For i = 1 To .GroupItems.Count
                ChangeFontInShape .GroupItems(i), newFontName
            Next i
        Else
            If .HasChart Then
                ' チャートのフォントを変更
                ChangeFontForChart .Chart, newFontName
            ElseIf .HasSmartArt Then
                ' スマートアートのフォントを変更
                ChangeFontForSmartArt .SmartArt, newFontName
            ElseIf .HasTable Then
                ' テーブルのフォントを変更
                ChangeFontForTable .Table, newFontName
            ElseIf .HasTextFrame Then
                ' テキストフレームのフォントを変更
                If .TextFrame.HasText Then
                    With .TextFrame.TextRange.Font
                        .Name = newFontName
                        .NameFarEast = newFontName
                        .NameAscii = newFontName
                        .NameComplexScript = newFontName
                        .NameOther = newFontName
                    End With
                End If
                If .TextFrame2.HasText Then
                    With .TextFrame2.TextRange.Font
                        .Name = newFontName
                        .NameFarEast = newFontName
                        .NameAscii = newFontName
                        .NameComplexScript = newFontName
                        .NameOther = newFontName
                    End With
                End If
            End If
        End If
    End With
End Sub

Sub ChangeFontForChart(chartObj As Chart, newFontName As String)
    ' すべてのチャート要素のフォントを変更
    With chartObj
        .Format.TextFrame2.TextRange.Font.Name = newFontName
    End With
End Sub

Sub ChangeFontForSmartArt(smartArtObj As SmartArt, newFontName As String)
    ' すべてのスマートアート要素のフォントを変更
    Dim node As SmartArtNode
    For Each node In smartArtObj.AllNodes
        With node.TextFrame2.TextRange.Font
            .Name = newFontName
            .NameFarEast = newFontName
            .NameAscii = newFontName
            .NameComplexScript = newFontName
            .NameOther = newFontName
        End With
    Next node
End Sub

Sub ChangeFontForTable(tableObj As Table, newFontName As String)
    ' すべてのテーブルセルのフォントを変更
    Dim row As Integer, col As Integer
    For row = 1 To tableObj.Rows.Count
        For col = 1 To tableObj.Columns.Count
            tableObj.Cell(row, col).Shape.TextFrame.TextRange.Font.Name = newFontName
        Next col
    Next row
End Sub

パワポのフォントを一括変更するコードの実行方法

こちらのセクションでは、VBAをあまり使ったことがない方に向けて、パワポのファイル内のフォントを一括変更するVBAコードを実行する方法を解説します。下記のステップに従って実行してみてください。

  1. フォントを変更したいファイルで Alt + F11 キーを押して、ビジュアルコードエディタを開く
  2. Alt + IM を押して、新しいモジュールを挿入する
  3. コピペでVBAコードを貼り付けて、F5 キーを押してVBAコードを実行する
  4. 一括変更したい新たな任意のフォント名を入力する

これにより、現在開いているファイル内のすべてのフォントが一括で指定したフォントに変更されていることがわかります。ファイルを保存する際にはマクロなしブックとして保存し、マクロの情報は削除してしまってOKです。

ファイルをそのまま保存しようとすると、下記の警告画面が表示されます。こちらは通常のパワポのファイルをマクロ付きで保存しようとすると表示される警告のため、そのまま [はい] を押してマクロなしのファイルとして保存してしまってOKです。

以下の機能をマクロなしのプレゼンテーションに保存することはできません。

  • Visual Basic for Applications (VBA) プロジェクト

この機能を含めてファイルを保存する場合は、[いいえ] をクリックして [名前を付けて保存] ダイアログ ボックスに戻り、[ファイルの種類] ボックスでマクロ有効ファイルの種類を選択してください。

続行してファイルをマクロなしのプレゼンテーションとして保存しますか?

パワポのフォントを一括変更するコードの解説

マクロやVBAを勉強している方や興味がある方に向けて、こちらのコードがどのように動作しているか解説します。あまり興味がない方は読み飛ばしてしまって大丈夫です。

一括変更したいフォント名の確認

マクロを実行すると、ユーザーにフォント名を尋ねるダイアログボックスが表示されます。ここで入力したフォント名が一括変更して新たに設定されるフォントとなります。

Sub ChangeFontInAllShapes()
    ...
    ' ユーザーにフォント名を尋ねる
    newFontName = InputBox("フォント名を入力してください:")
    ...
End Sub
全スライド及び全シェイプのループ処理

ユーザーがフォント名を入力すると、プレゼンテーション内のすべてのスライドがループ処理されます。各スライドでは、すべてのシェイプがループ処理されます。その後、ChangeFontInShapeが実行され、シェイプの種類に応じて、以下の処理が行われます。それぞれ必要に応じてサブ関数が実行される形となります。

  • グループ化されたシェイプの場合:グループ内のすべてのシェイプに対してフォントを変更します。
  • チャートの場合:チャートのフォントを変更します。
  • スマートアートの場合:スマートアートのフォントを変更します。
  • テーブルの場合:テーブルのすべてのセルのフォントを変更します。
  • テキストフレーム (通常のシェイプ) の場合:テキストフレームのフォントを変更します。
Sub ChangeFontInAllShapes()
    ...
    ' すべてのスライドをループ
    For Each pptSlide In pptPres.Slides
        ' スライド内のすべてのシェイプをループ
        For Each pptShape In pptSlide.Shapes
            ' シェイプのフォントを変更する再帰関数を呼び出す
            ChangeFontInShape pptShape, newFontName
        Next pptShape
    Next pptSlide
    
    MsgBox "フォント変更が完了しました。"
End Sub

Sub ChangeFontInShape(shp As Shape, newFontName As String)
    ...
    With shp
        If .Type = msoGroup Then
            ' シェイプがグループの場合、グループ内のすべてのシェイプをイテレート
            For i = 1 To .GroupItems.Count
                ChangeFontInShape .GroupItems(i), newFontName
            Next i
        Else
            If .HasChart Then
                ' チャートのフォントを変更
                ChangeFontForChart .Chart, newFontName
            ElseIf .HasSmartArt Then
                ' スマートアートのフォントを変更
                ChangeFontForSmartArt .SmartArt, newFontName
            ElseIf .HasTable Then
                ' テーブルのフォントを変更
                ChangeFontForTable .Table, newFontName
            ElseIf .HasTextFrame Then
                ' テキストフレームのフォントを変更
                ...
            EndIf
        End If
    End With
End Sub
フォントの変更

各シェイプで呼び出されたChangeFontInShapeに基づき、各オブジェクトのフォーマットまたはテキストフレームからフォントが設定されます。様々なオブジェクトで使用されるフォント設定のロジックとしては、下記の通りで通常のフォント名に加えてあらゆる文字形式を考慮してフォントが一括変更されます。

Sub ChangeFontInAllShapes()
    ...
    ' すべてのスライドをループ
    For Each pptSlide In pptPres.Slides
        ' スライド内のすべてのシェイプをループ
        For Each pptShape In pptSlide.Shapes
            ' シェイプのフォントを変更する再帰関数を呼び出す
            ChangeFontInShape pptShape, newFontName
        Next pptShape
    Next pptSlide
    
    MsgBox "フォント変更が完了しました。"
End Sub

Sub ChangeFontInShape(shp As Shape, newFontName As String)
    ...
    With shp
        If .Type = msoGroup Then
            ' シェイプがグループの場合、グループ内のすべてのシェイプをイテレート
            For i = 1 To .GroupItems.Count
                ChangeFontInShape .GroupItems(i), newFontName
            Next i
        Else
            ElseIf .HasTextFrame Then
                ' テキストフレームのフォントを変更
                If .TextFrame.HasText Then
                    With .TextFrame.TextRange.Font
                        .Name = newFontName
                        .NameFarEast = newFontName
                        .NameAscii = newFontName
                        .NameComplexScript = newFontName
                        .NameOther = newFontName
                    End With
                End If
                If .TextFrame2.HasText Then
                    With .TextFrame2.TextRange.Font
                        .Name = newFontName
                        .NameFarEast = newFontName
                        .NameAscii = newFontName
                        .NameComplexScript = newFontName
                        .NameOther = newFontName
                    End With
                End If
            End If
        End If
    End With
End Sub

これらのコードにより、通常のシェイプ、グループ化されたシェイプ、チャートやグラフ、スマートアート、テーブルなど、あらゆるシェイプやオブジェクトのフォントが適切に変更されます。

おわりに

以上が、PowerPointでファイル内の全フォントを一括で置換するマクロ・VBAコードの紹介となります。

ご質問やご不明点がある場合はお気軽にコメントお待ちしております。

ご精読いただきありがとうございました。

コメント

タイトルとURLをコピーしました