【PowerPoint】合成音声ナレーション付き動画をPowerPointで簡単に作れる！【マクロ】

アシュリー

2021年2月24日Microsoft365動画,PowerPoint,VBA

マークアップエンジニアのアシュリーです！

今回は『研修動画をパワポのスクリーンリーダー機能を使って作ろうと思ったけど録画に音声が入らない』というお悩みに答えて、合成音声ナレーション付き動画をPowerPointで作ります！

作るもの

PowerPointスライドノートをWindows10の合成音声に読み上げさせて、１つの動画ファイル（MP4）にしたもの

準備するもの

PowerPoint の入ったWindows10のパソコン
- PowerPointオンラインでは動きません
- 今回筆者は「PowerPoint for Microsoft 365」を使用しています
動画にしたいPowerPointファイル
- 読み上げたい文章をノートに書きこんでおきます

合成音声ナレーション付き動画の作り方

PowerPointの設定「記録」「開発」のタブの表示

[ファイル]→[オプション]　でPowerPointのオプションを表示。
[リボンのユーザー設定]から[記録]と[開発]にチェックを入れてください

「記録」と「開発」がタブに表示されます。

マクロ（VBA）のコードの準備

「開発」タブの[Visual Basic]をクリックして、コードを入力する画面を開きます

[挿入]→[標準モジュール]をクリックします。

すると、下記のような画面が出てくるので、この後に記載されているコードをコピーして貼り付けます。

Sub SlideVoice()
    Dim i As Long
    With ActivePresentation
        For i = 1 To .Slides.Count

            ' 現在のスライドのノートを取得
            Dim strNote As String
            strNote = ActivePresentation.Slides(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
        
            ' ノートが空白なら以下は実行しない
            If strNote = "" Then
            Else
                ' PowerPointファイルのあるフォルダパスを取得
                Dim cd As String
                cd = ActivePresentation.Path
            
                ' PowerPointファイルがあるのと同フォルダに、wavファイルを作成
                Dim wavePath As String
                wavePath = cd & "\voice.wav"
            
                ' 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
            
                Set oSlide = ActivePresentation.Slides(i)
                Set oShp = oSlide.Shapes.AddMediaObject2(wavePath, False, True, 10, 10)
            
                With oShp.AnimationSettings.PlaySettings
                    .PlayOnEntry = True
                    .HideWhileNotPlaying = True
                End With
            
            
                ' 埋め込み終わったらwavファイルを消す
                Dim fso As Object
                Set fso = CreateObject("Scripting.FileSystemObject")
                If fso.FileExists(wavePath) Then Kill wavePath
            
            End If
        Next i
    End With

    MsgBox "音声埋め込み完了"

End Sub