アルゴリズム
前回は資料内の全てのフォントを一括変更するコードを作りました(前回の記事)。今回はスライド内、つまり選択したページ内のフォントを変更するコードを作ります。アルゴリズムの概要は現在開いているスライドオブジェクトを取得し、そのスライド内のシェイプをループで1つずつフォントを変更できるかどうか判定していきます。フォント変更可能かどうかの判定は今までと同じテキストフレームの有無で判定します。テキストフレームを持っていた場合フォントが変わる仕組みとなっています。
まずは以下手順を行いユーザーフォーム起動中もスライドを切り替えられるようにします。
以下がコードです。
コード
'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 changeSlideFont()
Dim sld As Slide
Dim shp As Shape
Dim gshp As Shape
Dim val As Integer
Dim num As Integer
Dim i As Integer
Dim str As String: str = UserForm1.cmB_font.Text
Dim row As Integer '表行数用変数
Dim col As Integer '表桁数用変数
num = ActiveWindow.Selection.SlideRange.SlideIndex '現在開いているスライド番号を取得
For Each shp In Application.ActivePresentation.Slides(num).Shapes
val = shp.Type
Select Case val
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 gshp.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
End Sub'VBAユーザーフォーム
Option Explicit
Private Sub cB_font_Click()
Call changeSlideFont
'Call changeAllFont
End Sub
'ユーザーフォーム起動時の処理
Public Sub UserForm_Initialize()
Call setFontItems
End Sub前回作ったchangeAllFont関数はコメントアウトし実行します。現在開いているスライド内の全てのフォントが変わったと思います。次回はマウスドラッグで範囲指定した部分のフォントを変更する機能を実装します。