PowerPointのページ番号をテキストボックスに自動入力するVBAマクロ

自作プログラム

諸事情でパワーポイントのページ番号をテキストボックスで入力することがあるのですが、100ページ近くあるものを手入力するのはなかなかつらいです。

しかも、途中でページの追加や削除があって番号がずれたら全部やり直し…

そこで、セクションごとに自動でテキストボックスにページ番号を入力するマクロを作成しました。

スポンサーリンク

追記

後日、テキストボックスではなくフッターを利用したほうが楽なことに気づきました。

改良版のマクロはこちら。

PowerPointのページ番号をフッターに自動入力するVBAマクロ(改良版)
以前の記事で、セクションごとに自動でテキストボックスにページ番号を入力するマクロを紹介しました。その後、テキストボックスの代わりにフッターを使えば何かと都合がいいことに気づいたので、マクロを改良しました。今回は...

作成の経緯

私は1つの文書を作成するのにワードとパワーポイントの両方を使うことがあります。
ようは文章中心の部分はワード、図表が中心の部分はパワポと分割しているのです。

しかもワードとパワポが入り混じっています。
例えば最初の30ページはワード、次の30ページはパワポ、その次はワード・・・といった具合です。

これらに最初から順番にページ番号をつけようと思うとなかなか難しくて面倒…
ワードであればセクションごとにページ番号を独立させられるが、パワーポイントにそのような機能はありません。
「あるスライドをとばして番号を振る」といったことも不可能です。

そんな理由から、パワポではわざわざテキストボックスを使ってページ番号を入力しています。
しかし番号は手入力だし、ワードのページが1枚変わっただけでパワポのページ番号もすべて振りなおさなければなりません。

これはさすがにやってられないと思い、ページ番号を既存のテキストボックスに自動で入力するマクロをVBAで作ってみました。
もちろん、セクションごとに独立した番号から始めることもできる。

マクロの使い方と機能紹介

マクロを使うには、ページ番号を入力するためのテキストボックスがスライドにあらかじめ設置されている必要があります。

各スライドにあるテキストボックスのうち、最も下にあるものにページ番号が入力されます。
位置は図形の中心線で判断しており、下の例では「左の図形のほうが下にある」とみなされます。

また、このマクロはセクション区切りが入ったファイルでの使用を前提としています。
区切りが存在しないとおそらくエラーが出ます。

例えば下の図のように、スライド5(セクション1に所属)を選択した状態でマクロを起動したとします。

すると、開始番号を入力するダイアログが表示されます。

例えば「8」と入力したとします。

「OK」を押すと、選択されたセクションのすべてのスライドにページ番号が入力されます。
今回の例では次のようになります(下の図は再掲)。

  • スライド4:8
  • スライド5:9
  • スライド6:10
  • スライド7:11

また、セクションの先頭スライドにはページ番号を入力しないように設定することもできます。
その場合、先頭スライドは無いものとして2番目以降のスライドから番号が振られます。
先ほどの例では次のとおり。

  • スライド4:なし
  • スライド5:8
  • スライド6:9
  • スライド7:10

同様に、非表示スライドに番号を振らないことも可能。

マクロのコード

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 '数字以外が入力されたら繰り返す
  
  Dim Y As Variant 'スライド上端から図形の中心までの距離を記録
  Dim maxY As Variant, maxName As Variant '中心位置が最も下にあるシェイプの名前を記録
  
  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 iArray(slide_n) As Long  '変数では要素数を指定できないのでReDimを使う
    Dim i 'スライドインデックス
    Dim i2 As Integer: i2 = 0 '配列のインデックス
    For i = start_i To start_i + slide_n - 1
      iArray(i2) = i  'セクション内の全スライドのSlideIndexを格納
      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
        maxY = 0 'リセット
        For Each shp In sld.Shapes 'スライド内の全シェイプ
          If shp.Type = msoTextBox Then 'テキストボックスを判定
            Y = shp.Top + shp.Height / 2
            
            If Y > maxY Then
              maxY = Y
              maxName = shp.Name
            End If
            
          End If
        Next shp
      
      sld.Shapes(maxName).TextFrame.TextRange.Text = Str(start) 'テキストボックスへの入力
      start = start + 1
continue:
    Next sld
    'Next i
  End With  
End Sub

あまり美しいコードとは言えませんね…

特にセクションのスライドをforループで取得する処理は、配列を使わずにスライドのコレクションから直接取得すべきだと思いました。
その方針でいろいろ試したのですが「オブジェクト変数または With ブロック変数が設定されていません。」のエラーが出続けたのであきらめました。
おそらくオブジェクトがうまく取得できていないのでしょうが解決策が見つからず…

なお、あるシェイプ(図形)を同じスライド内にコピー&ペーストしたとしても、シェイプの名前は別のものが自動で割り当てられるようです。
ただし、別のスライドからコピーしてきたり、ユーザーが名前を変更した場合は名前が重複してしまいます。

おわりに

このマクロの用途はかなり限定的なもののため需要は少ないでしょうが、もしも誰かの役に立つなら幸いです。

あとは自動的にページ番号用のテキストボックスを挿入するか、1つのスライドに設置した図形を全てのスライドにコピーするマクロがあるとより便利かもしれません。今回はそこまで作る気力がありませんでした…
上でも述べましたが、フッターを使えばテキストボックスをいちいち挿入する必要はありません。

PowerPointのページ番号をフッターに自動入力するVBAマクロ(改良版)
以前の記事で、セクションごとに自動でテキストボックスにページ番号を入力するマクロを紹介しました。その後、テキストボックスの代わりにフッターを使えば何かと都合がいいことに気づいたので、マクロを改良しました。今回は...

参考資料

今回のマクロの土台となったコード

テキストボックスだけを選択するPowerPointマクロ:パワーポイントマクロ・PowerPoint VBAの使い方/Shape・図形

アクティブスライドが属するセクションのスライド取得に利用

VBAでアクティブセクションの先頭と最後のスライド番号を取得する:パワーポイントマクロ・PowerPoint VBAの使い方/Slide・スライド

UWSCでPowerPointのスライドをセクションを指定して抜き出す→動画保存 – Qiita

図形の中心位置の算出法

図形の座標を提供するShpClsを育ててみる。 – Powerpoint VBAを使おう!

ループやcontinueについて

VBA Do Loop 文

配列の長さを変数で指定する方法

VBAで配列の長さを指定するのに変数を使う方法 | かずさプログラマーの雑記帳

公式ドキュメント

PowerPoint 2010 VBA の基礎知識 | Microsoft Docs

PowerPoint Visual Basic for Applications (VBA) リファレンス | Microsoft Docs

Visual Basicの「オブジェクト ブラウザー」
メニューバーの「表示」→「オブジェクトブラウザー」もしくはF2キーで開く

ここに挙げたのは主だったもののみであり、これ以外にもたくさんのサイトを参考にさせていただきました。

コメント

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