標準モジュールコード
前回はコンボボックスのイベントについて記載しました(前回の記事)。今回はコンボボックスで一括を選択し実行ボタンを押すと、プレゼンテーションないの全てのフォントが一括で変わる機能を実装します。【パワポ検索ツールを作る2】ForEachの記事で解説したループとIf文を使ってアルゴリズムを組み立てます。標準モジュールとユーザーフォームのコードを以下に記載します。
'VBA標準モジュール
Option Explicit
'コンボボックスにフォントを設定
Public Sub setFontItems()
Dim Items As String
With UserForm1
.cmB_font.Clear 'コンボボックス内初期化
Items = "Meiryo UI,ＭＳ ゴシック" '内容をカンマで区切り記載
.cmB_font.List = Split(Items, ",") 'カンマで区切る
End With
End Sub
'--------------------フォント一括変更-------------------
Sub changeAllFont()
Dim sld As Slide 'スライド用変数
Dim shp As Shape 'シェイプ用用変数
Dim gshp As Shape 'グループ化シェイプ用変数
Dim str As String: str = UserForm1.cmB_font.Text 'コンボボックスの設定内容を取得
Dim row As Integer '表行数用変数
Dim col As Integer '表桁数用変数
For Each sld In Application.ActivePresentation.Slides '全スライドを見るループ
For Each shp In sld.Shapes '全シェイプを見るループ
Select Case shp.Type 'シェイプのタイプを判定
'オートシェイプ、吹き出し、プレースホルダー、テキストボックスの時
Case msoAutoShape, msoCallout, msoPlaceholder, msoTextBox
If shp.HasTextFrame = True Then 'テキストフレーム有の時
With shp.TextFrame.TextRange.Font
.Name = str 'フォント変更
.NameFarEast = str 'アジア言語のフォント変更
End With
End If
Case msoGroup 'グループの時
For Each gshp In shp.GroupItems
If gshp.HasTextFrame Then
With shp.TextFrame.TextRange.Font
.Name = str
.NameFarEast = str
End With
End If
Next
Case msoTable '表の時
With shp.Table
For row = 1 To .Rows.Count '全ての行を見るループ
For col = 1 To .Columns.Count '全ての列を見るループ
With .Cell(row, col).Shape.TextFrame.TextRange.Font
.Name = str
.NameFarEast = str
End With
Next col
Next row
End With
End Select
Next shp
Next sld
End Sub
ユーザーフォームコード
'VBAユーザーフォーム
Option Explicit
Private Sub cB_font_Click()
Call changeAllFont
End Sub
'ユーザーフォーム起動時の処理
Public Sub UserForm_Initialize()
Call setFontItems
End Subコンボボックスに内容をセットする際、アジア言語の場合はプロパティが異なる為注意してください。日本語のフォントはFarEastNameプロパティを変更する為のコードを記載すれば良いのですが、本テストコードでは汎用的にする為2つのプロパティに設定しています。
動作させると全てのフォントが変わったと思います。もし一括変更を誤ってしてしまった場合、エクセルVBAと違いパワーポイントVBAは戻るボタンで戻せますがエクセルVBAは戻せません。注意してください。
次回は現在表示されているスライド内のフォントを変えるやり方を解説します。