仕事でパワポをよく使われる皆さん、スライドの下にある「ノート」機能を使っていますか？私は、セミナー講師として年に100回近く人前で話す仕事をしているので、パワポは日常頻繁に使いますし、ノートも活用しています。

たまに、セミナー動画(YouTubeなど)への出演を依頼されることがあるのですが、スライドデータの他に台本の事前提出を求められることがあります。パワポには、あらかじめノート部分を書き出す機能はついているものの、なぜか私の環境では途中でエラーが出て止まってしまいます。毎回です。トホホ。

そこで、何かいい方法はないかと生成AIに相談してみたところ、VBAマクロを使えばできますよと教えてくれました。しかし、しかし、しかし！VBAマクロなんて使ったことがないんだけど！怖いんだけど！と思いつつも、背に腹は代えられず、AIの回答通りにやってみたら…
・
・
・

できたーーーー！

しかも一瞬で！！

・
・
・

という訳で、もしかしたら私と同じようにやり方を探している人がいるかも知れないので、手順を書いておきます。

VBAマクロを使ってパワーポイントの「ノート」をテキストで抽出する方法

先述したようにVBAマクロの知識がなくてもOK！使ったことがなくても大丈夫です。

以下の手順で試してみてください。マジで一瞬です。（ただし、自己責任にてお願いします）

PowerPointで対象の資料を開く
Alt + F11 を押す
VBAエディタが開いたら、上部メニューから挿入 → 標準モジュール
下記コードを貼り付ける
F5 キーで実行
PowerPointファイルと同じフォルダにnotes_text.txt が作成されます

▼貼り付けるコード（コピペして、4.の画面で貼り付け）

Sub ExtractSpeakerNotesToText()

Dim pres As Presentation
Dim sld As Slide
Dim shp As Shape
Dim fso As Object
Dim ts As Object
Dim outPath As String
Dim notesText As String
Dim t As String
Dim pType As Long
Dim foundBody As Boolean

Set pres = ActivePresentation

If pres.Path = “” Then
MsgBox “先にPowerPointファイルを保存してください。”
Exit Sub
End If

outPath = pres.Path & “\notes_text.txt”

Set fso = CreateObject(“Scripting.FileSystemObject”)
Set ts = fso.CreateTextFile(outPath, True, True)

For Each sld In pres.Slides

notesText = “”
foundBody = False

On Error Resume Next

‘ まず、ノート本文のプレースホルダーだけを探す
For Each shp In sld.NotesPage.Shapes
If shp.Type = msoPlaceholder Then
pType = shp.PlaceholderFormat.Type

If pType = ppPlaceholderBody Then
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
t = shp.TextFrame.TextRange.Text
If Len(Trim(t)) > 0 Then
notesText = notesText & t & vbCrLf
foundBody = True
End If
End If
End If
End If
End If
Next shp

‘ ノート本文が取れなかった場合の保険
If foundBody = False Then
For Each shp In sld.NotesPage.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
t = shp.TextFrame.TextRange.Text

‘ ヘッダー、フッター、日付、スライド番号っぽいものは除外
If Len(Trim(t)) > 0 Then
If shp.Type = msoPlaceholder Then
pType = shp.PlaceholderFormat.Type
If pType <> ppPlaceholderHeader _
And pType <> ppPlaceholderFooter _
And pType <> ppPlaceholderDate _
And pType <> ppPlaceholderSlideNumber Then

notesText = notesText & t & vbCrLf
End If
Else
notesText = notesText & t & vbCrLf
End If
End If
End If
End If
Next shp
End If

On Error GoTo 0

If Len(Trim(notesText)) > 0 Then
ts.WriteLine “——————————”
ts.WriteLine “Slide ” & sld.SlideIndex
ts.WriteLine “——————————”
ts.WriteLine notesText
ts.WriteLine “”
End If

Next sld

ts.Close

MsgBox “ノートの抽出が完了しました。” & vbCrLf & outPath

End Sub