PowerPoint のノートを音声読み上げしてスライドに埋め込む

# はじめに

遠隔授業用の動画をPowerPointで作るにあたり、ノートを合成音声で読み上げて、スライドにオーディオ・オブジェクトとして埋め込むマクロを作成しました。

Windows限定です。

# 開発環境

Windows 10 Home
Microsoft PowerPoint for Office 365 MSO (16.0.11929.20708) 32ビット

# 準備

マクロを使うので、スライドをマクロ有効プレゼンテーション(.pptm)で保存します。
PowerPointのメニューに「開発」がない場合は、「ファイル」→「オプション」→「リボンのユーザー設定」で「開発」にチェックを入れてください。

# コードの入力

「開発」→「Visual Basic」でVBAエディタを開き、プロジェクト エクスプローラの「標準モジュール」を右クリックして、「挿入」→「標準モジュール」で新規モジュール(Module1)を作成します。

<img width="443" alt="capture2.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/109010/042204de-13ee-c9bc-cbbd-53ca9685fa68.png">

Module1をダブルクリックするとコードを入力するウィンドウが開くので、以下のコードを入力します。

```VBA
Sub EmbedVoice()

    ' 現在のスライド番号を取得
    Dim n As Long
    n = ActiveWindow.Selection.SlideRange.SlideIndex
    
    ' 現在のスライドのノートを取得
    Dim strNote As String
    strNote = ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
    
    ' ノートが空白なら終了
    If strNote = "" Then
        Exit Sub
    End If
    
    ' 現在のフォルダを取得
    Dim cd As String
    cd = ActivePresentation.Path
    
    ' wavファイルのパスを作成
    Dim wavePath As String
    wavePath = cd & "\voice.wav"
    
    ' wavファイルが既にあれば削除
    ' 下の SSFMCreateForWrite = 3 で上書きできるはずだけど何故かできないので
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(wavePath) Then Kill wavePath
    
    ' wavファイルに保存
    Const SAFT48kHz16BitStereo = 39
    Const SSFMCreateForWrite = 3
    
    Dim oFileStream, oVoice
    
    Set oFileStream = CreateObject("SAPI.SpFileStream")
    oFileStream.Format.Type = SAFT48kHz16BitStereo
    oFileStream.Open wavePath, SSFMCreateForWrite
    
    Set oVoice = CreateObject("SAPI.SpVoice")
    Set oVoice.AudioOutputStream = oFileStream
    oVoice.Speak strNote
    
    oFileStream.Close
    
    ' audioオブジェクトの埋め込み
    Dim oSlide As Slide
    Dim oShp As Shape
    Dim oEffect As Effect
    
    Set oSlide = ActivePresentation.Slides(n)
    
    Set oShp = oSlide.Shapes.AddMediaObject2(wavePath, False, True, 10, 10)
    
    With oShp.AnimationSettings.PlaySettings
        .HideWhileNotPlaying = True
    End With
        
    MsgBox "Done."

End Sub
```

# 使い方

音声を埋め込みたいスライドのノートに、読み上げるテキストを入力します。

<img width="298" alt="capture1.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/109010/2102366c-cbdf-bfb2-cfa3-ed45a32b1b50.png">

「開発」→「マクロ」から、EmbedVoice を実行すると、スライドの左上にオーディオ・オブジェクトが挿入されます。

<img width="295" alt="capture4.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/109010/de22628f-e9ca-c065-eb4b-885c09072383.png">

オーディオ・オブジェクトにマウスカーソルをあてると再生ボタンが表示されるので、実際に再生して音声を確認してください。

<img width="351" alt="capture3.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/109010/c5c56356-7c59-a8be-75a9-21d6dbe32061.png">

問題がある場合は、オーディオ・オブジェクトを削除し、ノートを修正してから、もう一度 EmbedVoice を実行してください。

埋め込みの時点で、「スライドショーを実行中にサウンドのアイコンを隠す」設定だけオンにしてあります。その他の設定は「再生」メニューや「アニメーション」メニューで行ってください。

# 備考

- 音声はWindowsの音声読み上げ機能を使って作成しています。
- 処理の過程で、スライドと同じフォルダにvoice.wavというファイルを作りますので、不要なら削除してください。
- Webで調べながら作成したので、技術的な質問にはお答えできません。

# 参考にしたサイト

- [しゃべるパワポの作り方 - 格子点](https://www.google.com/url?sa=t&rct=j&q=&esrc=s&source=web&cd=3&cad=rja&uact=8&ved=2ahUKEwjGnN3M15_pAhURHaYKHRYRDm8QFjACegQIBBAB&url=https%3A%2F%2Frecruit-lattice.jp%2Fppt_tts_1%2F&usg=AOvVaw2XdGfH9Jx-gs7WuA2aNlpb)
- [How to save SAPI text to speech to an audio file in VBScript?](https://stackoverflow.com/questions/20498004/how-to-save-sapi-text-to-speech-to-an-audio-file-in-vbscript)
- [Add audio clip via VBA to PowerPoint Presentation that spans multiple slides](https://stackoverflow.com/questions/6986507/add-audio-clip-via-vba-to-powerpoint-presentation-that-spans-multiple-slides)