![見出し画像](https://assets.st-note.com/production/uploads/images/142449831/rectangle_large_type_2_7d8eae038c2a15513186dc57c830e44c.jpeg?width=1200)
知識ゼロから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を使ったプログラムの生成により、調べるところから始めなければならない作業をたった5分で終わらせることができました。
これまでエクセル以外でVBAを使ってきませんでしたが、ChatGPTを使うことでWordやPowerPointにも短時間で様々な便利機能を実装できそうです。
皆さんもぜひ試してみてください!
最後までご覧いただきありがとうございました!
この記事が気に入ったらサポートをしてみませんか?