powerpointのノートを音声合成して貼り付け、動画を作成する
2023/11/4改訂『パワーポイント ビデオ作製 音声の改善』生徒に便利なように次の操作をしているパワーポイントのノートを音声合成でスライドに自動挿入しているこのスライドをビデオに変換すると、いつでもプレゼンを見られるし…ameblo.jppowerpointをプレゼンをするのですが、あとで再利用したいです ノートにプレゼンで話すことを記述します ノートをwindows標準の音声合成でWAVにします WAVをスライドに貼り付けます powerpointで動画を作成します 作成した動画を公開しますこれで再利用ができます使うのはVBAとwindows標準機能のみですマクロは以下です'参照サイト https://www.alta.co.jp/blog/post-1725/Sub create() Call SlideVoice Call SaveVideo MsgBox "完了"End SubSub SaveVideo() ActivePresentation.CreateVideo (ActivePresentation.Path & "\test.mp4")End SubSub SlideVoice() Dim i As Long Dim cd As String Dim wavePath As String Const SAFT48kHz16BitStereo = 39 Const SSFMCreateForWrite = 3 Dim oFileStream, oVoice Dim oSlide As Slide Dim oShp As Shape Dim fso As Object Dim strNote As String cd = ActivePresentation.Path ' PowerPointファイルのあるフォルダパスを取得 wavePath = cd & "\voice.wav" ' PowerPointファイルがあるのと同フォルダに、wavファイルを作成 With ActivePresentation For i = 1 To .Slides.Count 'スライドの数だけ行う strNote = ActivePresentation.Slides(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text ' 現在のスライドのノートを取得 If strNote <> "" Then ' ノートが空白なら以下は実行しない Set oFileStream = CreateObject("SAPI.SpFileStream") ' wavファイルに保存 oFileStream.Format.Type = SAFT48kHz16BitStereo '音声フォーマット oFileStream.Open wavePath, SSFMCreateForWrite '書き込みモード Set oVoice = CreateObject("SAPI.SpVoice") '音声合成 Set oVoice.AudioOutputStream = oFileStream '音声の出力先をファイルへ oVoice.Speak strNote 'ノートを話す oFileStream.Close 'ファイルをクローズ Set oSlide = ActivePresentation.Slides(i) '現在のスライドを取得 Set oShp = oSlide.Shapes.AddMediaObject2(wavePath, False, True, 10, 10) ' audioオブジェクトの埋め込み With oShp.AnimationSettings.PlaySettings 'アニメーションの設定 .PlayOnEntry = True '自動再生 .HideWhileNotPlaying = True '再生時にのみ表示 End With Set fso = CreateObject("Scripting.FileSystemObject") 'ファイル操作 If fso.FileExists(wavePath) Then Kill wavePath ' 埋め込み終わったらwavファイルを消す End If Next i End With MsgBox "音声埋め込み完了"End Sub
