PowerPoint 노트를 음성 읽고 슬라이드에 포함

소개

원격 수업용 동영상을 PowerPoint에서 만들 때 노트를 합성 음성으로 읽고 슬라이드에 오디오 객체로 포함하는 매크로를 만들었습니다.

Windows 한정입니다.

개발 환경

Windows 10 Home
Microsoft PowerPoint for Office 365 MSO(16.0.11929.20708) 32비트

준비

매크로를 사용하므로 슬라이드를 매크로 유효 프레젠테이션(.pptm)으로 저장합니다.
PowerPoint 메뉴에 "개발"이 없으면 "파일"→ "옵션"→ "리본 사용자 설정"에서 "개발"을 선택하십시오.

코드 입력

개발 → Visual Basic에서 VBA 편집기를 열고 프로젝트 탐색기에서 표준 모듈을 마우스 오른쪽 단추로 클릭하고 삽입 → 표준 모듈에서 새 모듈(Module1)을 만듭니다.

Module1을 더블 클릭하면 코드를 입력하는 창이 열리므로 다음 코드를 입력합니다.

Sub EmbedVoice()

    ' 現在のスライド番号を取得
    Dim n As Long
    n = ActiveWindow.Selection.SlideRange.SlideIndex

    ' 現在のスライドのノートを取得
    Dim strNote As String
    strNote = ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text

    ' ノートが空白なら終了
    If strNote = "" Then
        Exit Sub
    End If

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

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

    ' wavファイルが既にあれば削除
    ' 下の SSFMCreateForWrite = 3 で上書きできるはずだけど何故かできないので
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(wavePath) Then Kill wavePath

    ' 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
    Dim oEffect As Effect

    Set oSlide = ActivePresentation.Slides(n)

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

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

    MsgBox "Done."

End Sub