以前の記事で、セクションごとに自動でテキストボックスにページ番号を入力するマクロを紹介しました。
その後、テキストボックスの代わりにフッターを使えば何かと都合がいいことに気づいたので、マクロを改良しました。
今回はその改良型マクロの紹介と使い方の補足をします。
マクロのコード
Sub セクションごとにフッターでページ番号を挿入()
'--------------------設定する変数ここから-----------------------
Dim pass_hidden: pass_hidden = True
'非表示スライドをとばす場合はTRUE、とばさない場合はFALSEにする
Dim pass_top: pass_top = True
'セクションの先頭スライドをとばす場合はTRUE、とばさない場合はFALSEにする
'--------------------設定する変数ここまで-----------------------
Dim start 'ページ番号の初期値
Do
start = InputBox("開始番号を入力:", "ページ番号の設定")
If IsNumeric(start) Then '入力値が数字か確認
start = Val(start)
Exit Do
ElseIf Len(start) = 0 Then End
End If
Loop
With ActiveWindow.Selection
Dim sec_id 'アクティブなスライドのセクションID
Dim start_i 'セクションの先頭スライドのSlideIndex
Dim slide_n 'セクションのスライド数
sec_id = .SlideRange.sectionIndex
start_i = ActivePresentation.SectionProperties.FirstSlide(sec_id)
slide_n = ActivePresentation.SectionProperties.SlidesCount(sec_id)
If pass_top Then
start_i = start_i + 1
slide_n = slide_n - 1
End If
Dim iArray() As Long '変数では長さを指定できないのでReDimを使う
ReDim iArray(slide_n) As Long
Dim i 'スライドインデックス
Dim i2 As Integer: i2 = 0 '配列のインデックス
For i = start_i To start_i + slide_n - 1
iArray(i2) = i
i2 = i2 + 1
Next i
Dim sld As Slide
Dim shp As Shape
For Each sld In ActivePresentation.Slides.Range(iArray)
If pass_hidden And sld.SlideShowTransition.Hidden = msoTrue Then
GoTo continue
End If
sld.HeadersFooters.Footer.Text = Str(start) 'フッターへ入力
start = start + 1
continue:
Next sld
End With
End Sub
前回からの主な変更点は「フッターへの入力」処理を追加したこと(51行目)。
また、前回のコードにあった「スライドの一番下にある図形を探す」処理が不要になったため、行数を減らすことができました。
使い方
基本的な使用法は前回と同一です。
参考資料も掲載しているため、ぜひともあわせてご覧ください。
補足
フッターをページ番号に使う場合、「スライドマスター」でフッターの位置やフォントを設定すればすべてのスライドに一括で反映されます。
そのため、テキストボックスを使うよりかなり楽です。
スライドマスターはメニューの「表示」から開く。

すると、下のように複数のスライドが表示されます。

一番上のスライドを選択して編集すれば、すべての種類のスライドに変更を反映できます。
逆に、ある種類のスライドだけ(例:タイトルスライド)を変更することも可能。
おわりに
前回と同様かなり用途が限定されるマクロですが、何かのお役に立てたなら幸いです。
コメント