MENU
さぁ、ITの勉強をはじめよう！　Let's start studying IT!
  1. ホーム
  2. ITpassport
  3. PowerPointのノートから音声ファイルを生成し、それをスライドに埋め込むプログラム（A program that generates audio files from PowerPoint notes and embeds them into slides）

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

ITpassport PowerPoint
目次

日本語版（ゆっくり）

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
ITpassport PowerPoint
よかったらシェアしてね！
  • URLをコピーしました！
  • URLをコピーしました！

この記事を書いた人

GoodMorningのアバター 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.

関連記事

目次