VBA PowerPoint 全てのスライドを選択しながらスライドノートを音声に変換して埋め込む #VBA #PowerPoint #ノート #音声埋め込み

またまた浮気して人力検索から teratail の質問を答えて、恥をかいてみたり・・・
(※ここまできたら、浮気じゃなくて、あっちが本命か？ぉぃぉぃ・・・)

元ネタの質問ページは下記を見てください。※他の回答や質問のコードを参考にする。
teratail.com
PowerPointで音声データを埋め込み、終わったら次のスライドへ移動させたい
https://teratail.com/questions/tpr2jlldqc85js

↓いつものあのあのそのその酔っ払い説明動画・・・
https://www.youtube.com/watch?v=6gt1n0HZ6bM

00:00 やりたいこと
00:20 1.スライドの選択は ActivePresentation.Slides(n).Select
01:13 2.スライドの枚数は ActivePresentation.Slides.Count
02:30 3.ノートの取得 Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
05:16 4.全てのスライドを選択しながらノートを音声ファイルに変換して埋め込む

1.スライドの選択は ActivePresentation.Slides(n).Select
単純に
ActivePresentation.Slides(n).Select
みたいに、nページのスライドを選択できます

2.スライドの枚数は ActivePresentation.Slides.Count
スライドの枚数は、これも単純で
ActivePresentation.Slides.Count
と、.Countで求められます

3.ノートの取得 Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text

For n = 1 To ActivePresentation.Slides.Count
        ActivePresentation.Slides(n).Select   'n番目のスライドを選択する
        strNote = ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
        MsgBox n & "枚目のスライドノートは:" & strNote
Next

4.全てのスライドを選択しながらノートを音声ファイルに変換して埋め込む
単体ページの埋め込みができているので、
※アクティブなスライドのノートを音声変換して埋め込む
単純に完成済みの埋め込み() 関数を呼んでみた

Sub test()

    Dim n As Long                     '現在のスライド

    For n = 1 To ActivePresentation.Slides.Count
        ActivePresentation.Slides(n).Select   'n番目のスライドを選択する
        Call 埋め込み
    Next
    
    MsgBox "処理終了"

End Sub

'音声変換と埋め込みは
'質問ページ
'PowerPointで音声データを埋め込み、終わったら次のスライドへ移動させたい
' https://teratail.com/questions/tpr2jlldqc85js
'のコードをそのまま利用しました

Sub 埋め込み()

Dim n As Long                     '現在のスライド
Dim strNote As String             'ノート取得
Dim cd As String                  'フォルダを取得
Dim wavePath As String            'wavファイルを作成
Dim oFileStream, oVoice           'wavファイルに保存
Dim oSlide As Slide               '音声データ
Dim oShp As Shape

'現在のスライドのノートを取得
 n = ActiveWindow.Selection.SlideRange.SlideIndex
 
 strNote = ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
 
'ノートが空白なら終了
If strNote = "" Then
    Exit Sub
End If

'現在のフォルダを取得
cd = ActivePresentation.Path

'wavファイルのパスを作成
wavePath = cd & "\voice.wav"

'wavファイルに保存
Const SAFT48kHz16BitStereo = 39
Const SSFMCreateForWrite = 3

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オブジェクトの埋め込み(音声データを埋め込む)
Set oSlide = ActivePresentation.Slides.Item(n)

Set oShp = oSlide.Shapes.AddMediaObject2(wavePath, False, True, 10, 10)

With oShp.AnimationSettings.PlaySettings
    .HideWhileNotPlaying = True
    
End With
End Sub

↓いつものあのあのそのその酔っ払い動画・・・
www.youtube.com
https://www.youtube.com/watch?v=6gt1n0HZ6bM
00:00 やりたいこと
00:20 1.スライドの選択は ActivePresentation.Slides(n).Select
01:13 2.スライドの枚数は ActivePresentation.Slides.Count
02:30 3.ノートの取得 Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
05:16 4.全てのスライドを選択しながらノートを音声ファイルに変換して埋め込む