三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

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.全てのスライドを選択しながら ノートを音声ファイルに変換して埋め込む


パワポのノートに書いた文字列を簡単に音声に変換できたので、私も使ってみよう

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。
・[Excel/Access VBA]の解説
・[ASP(Active Server Pages)]の解説。
・[元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
・[プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
三流君を踏み台にする
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)