PowerPointのノートから音声ファイルを生成し、それをスライドに埋め込むプログラム（A program that generates audio files from PowerPoint notes and embeds them into slides）

2024年7月7日2024年8月21日

日本語版（ゆっくり）

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")
                ' ここで再生速度を調整する
                oVoice.Rate = -2
                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

英語版（ゆっくり）

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")
                ' ここで再生速度を調整する
                oVoice.Rate = -2
                ' 英語の音声エンジンを設定
                Set oVoice.Voice = oVoice.GetVoices("Language=409").Item(0)
                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

日本語版

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

英語版

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.Voice = oVoice.GetVoices("Language=409").Item(0)
                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

よかったらシェアしてね！

URLをコピーしました！

URLをコピーしました！

この記事を書いた人

GoodMorning

GoodMorning！

デジタルの海原を冒険しながら、美食の宝を探し求める探検家です。テクノロジーの世界を舞台に、新しい発見を求めて、キーボードの海を横断。そして、実世界では、隅々まで足を運んで、舌鼓を打つ価値のある美味しいお店を見つけ出します。

私の使命は、小さなITの豆知識から始まり、心を満たすグルメスポットの紹介まで、あなたの日常にちょっとしたスパイスを加えること。画面の向こう側から、気軽に楽しめる話題を届けたいのです。ここでは、私が「これは！」と思った技術的な小話や、舌の記憶に残るような食べ物屋さんを紹介していきます。

このWebサイトは、ITとグルメ、二つの世界を融合させた、まさにデジタルと現実の融合点。ふらっと立ち寄って、新たな発見や、ほっこりするような話題で一息ついていただけたら幸いです。知識の海を冒険し、味覚の旅を楽しみましょう。毎日を少しだけ特別なものに変える、そんな情報をお届けします。

GoodMorning!

I am an explorer who ventures across the digital sea in search of gastronomic treasures. In the world of technology, I traverse the sea of keyboards in search of new discoveries. And in the real world, I visit every nook and cranny to find a delicious restaurant worth tantalizing your taste buds.

My mission is to add a little spice to your everyday life, starting with little IT tidbits and ending with foodie spots that fill your heart. I want to bring you topics that you can easily enjoy from the other side of the screen. Here, I'm going to share with you some of the technical tidbits and I will introduce small technical stories and food shops that will leave a lasting impression on your taste buds.

This Web site is truly a fusion point of digital and reality, combining the two worlds of IT and gourmet. I hope you will stop by and take a breather with new discoveries and dusty topics. Come explore the sea of knowledge and enjoy a journey of taste. I will bring you the information that will change your everyday life into something a little more special.

PowerPointのノートから音声ファイルを生成し、それをスライドに埋め込むプログラム（A program that generates audio files from PowerPoint notes and embeds them into slides）

日本語版（ゆっくり）

英語版（ゆっくり）

日本語版

英語版

この記事を書いた人

関連記事