日曜プログラミング

休日趣味でやってるプログラミング関連記事をダラダラと

目次っぽいものを集める

PowerPoint で 100P 以上作成された資料があって更新する必要が出てきて、目次を手でズラして
更新するのは余りにもバカバカしいんでどうにかできんかちょっと調べてみた。

以前は UWSC 使ってたんだが単純な操作記録の繰り返しだとマウス座標やオブジェクト座標に左右
される部分があるので、VBA の方でもうちょい良い解決策を探ってみた。

多分 Office 全般なんだろうけどオブジェクトには名前を付ける事が可能なようなので、Slide はき
っとコレクションで持っていて For ループで回して "Title" オブジェクトを抽出するようにすれば
できるんじゃないかと思い立つ。

なので、全ての抽出したいテキストボックスオブジェクトに "Title" と付ける事にする。

  • 「ホーム」タブ→選択→オブジェクトの選択と表示(P)とすると、スライドのオブジェクト一覧が右にズラっと出てくる
  • 目次として抽出したいオブジェクトを選択すると右側のオブジェクト一覧もハイライトされるのでそいつをクリックして "Title" に変更する。手作業だが一度きりなので諦めてシコシコやる。
    • スライド追加時はこれらのスライドをコピペする形にするのを忘れずに
  • 目次の入れ先のオブジェクトを "TOC" とする

これで仕込みは完了。

こうしとけば、後は以下のようなマクロを走らせれば取得できた。

Sub makeTOC()

    Dim SLIDE_PAGE As Integer: SLIDE_PAGE = 7
    Dim sld As Slide
    Dim shp As Shape
    Dim strTOC As String

    strTOC = ""
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.Name = "Title" Then strTOC = strTOC & shp.TextFrame.TextRange.Text & vbCrLf
        Next
    Next

    ' 目次に入れる
    For Each shp In ActivePresentation.Slides(SLIEDE_PAGE).Shapes
        If shp.Name = "TOC" Then shp.TextFrame.TextRange.Text = strTOC
    Next

End Sub

スライドページ指定がマジックナンバーだったり、"TOC" オブジェクト探すのにわざわざまた For し
ているのが気に入らないが、メニューでのマクロ実行じゃ引数付けて実行もできないみたいだし
Excel の Sheet 指定みたいに Shapes("TOC") とする事もできなかったのでこの辺りで妥協しておく。

どうでもいいけどはてな記法のシンタックスハイライトの方がいい色付くなあ。