本記事では、パワポのファイルの全フォントを一括変更する方法をご紹介します。今回の方法ではマクロ・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コードを実行する方法を解説します。下記のステップに従って実行してみてください。
- フォントを変更したいファイルで Alt + F11 キーを押して、ビジュアルコードエディタを開く
- Alt + I → M を押して、新しいモジュールを挿入する
- コピペでVBAコードを貼り付けて、F5 キーを押してVBAコードを実行する
- 一括変更したい新たな任意のフォント名を入力する
これにより、現在開いているファイル内のすべてのフォントが一括で指定したフォントに変更されていることがわかります。ファイルを保存する際にはマクロなしブックとして保存し、マクロの情報は削除してしまってOKです。
パワポのフォントを一括変更するコードの解説
マクロや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コードの紹介となります。
ご質問やご不明点がある場合はお気軽にコメントお待ちしております。
ご精読いただきありがとうございました。
コメント