知識ゼロからPowerPointの目次を自動作成するプログラムが5分でできた話

皆さんこんにちは！ダイサンデジタル事業部です。
本日は、VBA（PowerPoint）知識ゼロの筆者が、目次を自動作成するプログラムを5分で作成した話を紹介します。

なぜ作成しようと思ったか

全体感を把握できるようにするため、資料作成時に目次を作成するようにしていますが、PowerPointにはWordと異なり目次を自動更新する仕組みがありません。
そのため、目次作成時には、手打ちもしくはアウトライン表示からスライドタイトルをコピペする必要がありました。
この作業がなかなか単純作業なので、ワンクリックで実現したいと思いプログラムを作成することにしました。

直面した課題とアプローチ

しかしながら、VBAでPowerPointを操作する方法を知らないので時間が掛かってしまう可能性がありました。1時間も2時間もかかってしまっては、タイパが良くありません。
そこで、新しく登場したChatGPT-4oを使って調べる作業とプログラムを書く作業を省略してみました。

ChatGPTで実践

下記が実際のプロンプトと、生成されたプログラムです。

プロンプト 
パワーポイントの各スライドタイトルボックスからテキストを抽出し、目次スライドを作成するVBAを作成してください。

Sub CreateAgendaSlide()
    Dim ppt As Presentation
    Dim sld As Slide
    Dim shp As Shape
    Dim agendaSlide As Slide
    Dim titleText As String
    Dim i As Integer

    ' 現在のプレゼンテーションを取得
    Set ppt = ActivePresentation
    
    ' 新しいスライドをアジェンダスライドとして追加
    Set agendaSlide = ppt.Slides.Add(1, ppLayoutText)
    agendaSlide.Shapes(1).TextFrame.TextRange.Text = "目次"
    agendaSlide.Shapes(2).TextFrame.TextRange.Text = ""
    
    ' 各スライドのタイトルを収集
    For i = 2 To ppt.Slides.Count
        Set sld = ppt.Slides(i)
        ' スライドのタイトルテキストを取得
        For Each shp In sld.Shapes
            If shp.Type = msoPlaceholder Then
                If shp.PlaceholderFormat.Type = ppPlaceholderTitle Then
                    titleText = shp.TextFrame.TextRange.Text
                    ' アジェンダスライドにタイトルを追加
                    agendaSlide.Shapes(2).TextFrame.TextRange.Text = agendaSlide.Shapes(2).TextFrame.TextRange.Text & titleText & vbCrLf
                End If
            End If
        Next shp
    Next i
End Sub

実際に動かしてみると、確かに目次が作成されました。
普段のアジェンダに形式を近づけるため、さらに細かな指定を行いました。指定した項目は以下の通りです。

フォント：BIZ UDPゴシック
フォントサイズ：20pt
段落番号付き：1.2….の形式

最終的に出来上がったプログラムがこちら

Sub CreateAgendaSlide()
    Dim ppt As Presentation
    Dim sld As Slide
    Dim shp As Shape
    Dim agendaSlide As Slide
    Dim titleText As String
    Dim i As Integer

    ' 現在のプレゼンテーションを取得
    Set ppt = ActivePresentation
    
    ' 新しいスライドをアジェンダスライドとして追加
    Set agendaSlide = ppt.Slides.Add(1, ppLayoutText)
    With agendaSlide.Shapes(1).TextFrame.TextRange
        .Text = "目次"
        .Font.Name = "BIZ UDPゴシック"
        .Font.NameFarEast = "BIZ UDPゴシック"
        .Font.Size = 24 ' アジェンダタイトルのフォントサイズを24ptに設定
    End With
    agendaSlide.Shapes(2).TextFrame.TextRange.Text = ""
    
    ' 各スライドのタイトルを収集
    For i = 2 To ppt.Slides.Count
        Set sld = ppt.Slides(i)
        ' スライドのタイトルテキストを取得
        For Each shp In sld.Shapes
            If shp.Type = msoPlaceholder Then
                If shp.PlaceholderFormat.Type = ppPlaceholderTitle Then
                    titleText = shp.TextFrame.TextRange.Text
                    ' アジェンダスライドにタイトルを追加
                    With agendaSlide.Shapes(2).TextFrame.TextRange
                        .Text = .Text & titleText & vbCrLf
                        With .Paragraphs(.Paragraphs.Count).ParagraphFormat.Bullet
                            .Visible = msoTrue
                            .Type = ppBulletNumbered
                            .Style = ppBulletArabicPeriod ' 段落番号を "1. 2. 3." の形式に設定
                        End With
                        .Paragraphs(.Paragraphs.Count).Font.Name = "BIZ UDPゴシック"
                        .Paragraphs(.Paragraphs.Count).Font.NameFarEast = "BIZ UDPゴシック"
                        .Paragraphs(.Paragraphs.Count).Font.Size = 20 ' フォントサイズを20ptに設定
                    End With
                End If
            End If
        Next shp
    Next i
End Sub

このプログラムをPowerPointのマクロに登録して実行すると、思った通りのスライドが出力されました！

おわりに

ChatGPTを使ったプログラムの生成により、調べるところから始めなければならない作業をたった５分で終わらせることができました。
これまでエクセル以外でVBAを使ってきませんでしたが、ChatGPTを使うことでWordやPowerPointにも短時間で様々な便利機能を実装できそうです。
皆さんもぜひ試してみてください！
最後までご覧いただきありがとうございました！