Question

我的任务是建立一个自动Powerpoint，以在入职时向新员工展示。我决定使用PPT的文字转语音功能对节目进行叙述。我意识到这将需要代码，因此我搜索并找到了一些要使用的代码。当我在VBA中启动它时，它将运行。但是，在演示模式下，它不会触发代码。经过数小时的搜索，我似乎找不到做错了什么。任何帮助是极大的赞赏。

Function SpeakThis(myPhrase As String)
Dim oSpeaker As New SpeechLib.SpVoice

'Set speech properties
oSpeaker.Volume = 100 ' percent
oSpeaker.Rate = 0.1 ' multiplier
oSpeaker.SynchronousSpeakTimeout = 1
oSpeaker.AlertBoundary = SVEWordBoundary

If Not myPhrase = "" Then oSpeaker.Speak myPhrase, SVSFDefault
End Function

Sub OnSlideShowPageChange()
Dim text As String
Dim intSlide As Integer
intSlide = ActiveWindow.Selection.SlideRange.SlideIndex

text = ActivePresentation.Slides(intSlide).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text
SpeakThis text
End Sub

Answer 1

要获取当前幻灯片索引，可以使用以下内容：

在幻灯片视图模式下：ActiveWindow.View.Slide.SlideIndex
在幻灯片放映模式下：ActivePresentation.SlideShowWindow.View.Slide.SlideIndex

要使其在演示文稿模式下工作，请更改

intSlide = ActiveWindow.Selection.SlideRange.SlideIndex

到

intSlide = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex

请注意，如果不在演示模式下，则会引发错误。

编辑：以简化形式，您也可以这样做：

Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)

    SpeakThis Wn.View.Slide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text

End Sub

Answer 2

在这里，我介绍可以满足您想要的解决方法。

实际上，您可以在TTS声音上方保存到.wav文件中可以在进入每张幻灯片时插入并播放。由于您想在每张幻灯片上播放旁白声音，建议您将所有注释转换为.wav文件，并将其作为普通音频效果插入。

为使过程自动化，我编写了一些代码。

首先，将每个笔记保存为.wav文件（根据幻灯片索引）

'save the slide's note in a .wav file
'You need to add reference to 'Microsoft Speech Object Library' (*required*)
Function SaveTTSWav(idx As Long)
    Const SAFT48kHz16BitStereo = 39
    Const SSFMCreateForWrite = 3
    Dim oSpeaker As New SpeechLib.SpVoice
    Dim oStream As New SpeechLib.SpFileStream

    oStream.Format.Type = SAFT48kHz16BitStereo
    'filename to save: ex) note1.wav
    oStream.Open ActivePresentation.Path & "\note" & idx & ".wav", SSFMCreateForWrite, False
    oSpeaker.Volume = 100   '%
    oSpeaker.Rate = 1       '1x speed
    oSpeaker.SynchronousSpeakTimeout = 1
    oSpeaker.AlertBoundary = SVEWordBoundary
    Set oSpeaker.AudioOutputStream = oStream

    oSpeaker.Speak ActivePresentation.Slides(idx).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text, SVSFNLPSpeakPunc
    oStream.Close
End Function

然后，在每张幻灯片中插入'note（X）.wav'文件并向其中添加动画效果：

'insert the .wav and make it play automatically
Function AddTTSMedia(idx As Long)
    Dim sld As Slide
    Dim shp As Shape
    Dim eft As Effect

    Dim wavfile As String

    wavfile = ActivePresentation.Path & "\note" & idx & ".wav"
    If Len(Dir(wavfile)) = 0 Then Exit Function
    Set sld = ActivePresentation.Slides(idx)
    Set shp = sld.Shapes.AddMediaObject2(wavfile, False, True, 0, 0, 20, 20)
    'shp.Name = Mid(wavfile, InStrRev(wavfile, "\") + 1) '.wav filename
    Set eft = sld.TimeLine.MainSequence.AddEffect(shp, msoAnimEffectMediaPlay, , msoAnimTriggerWithPrevious)
    eft.MoveTo 1    'make it the first effect
    With eft.EffectInformation.PlaySettings 'shp.AnimationSettings.PlaySettings
        .HideWhileNotPlaying = True
        .PauseAnimation = False
        .PlayOnEntry = True
        .StopAfterSlides = 1
    End With
    'Kill wavfile
End Function

最后，使它发生在每张幻灯片上：

Sub Add_TTS_Notes()
    Dim sld As Slide

    'Remove previously inserted note sounds
    RemoveNoteWav

    For Each sld In ActivePresentation.Slides
        'save the note to an .wav file
        SaveTTSWav sld.SlideIndex
        'add the .wav file onto the slide
        AddTTSMedia sld.SlideIndex
    Next sld
    'ActivePresentation.Save
End Sub

此外，如果您想取消和删除演示文稿中的所有笔记声音，您可以手动运行以下代码：

'remove all .wav media(s) in each slide
Sub RemoveNoteWav()
    Dim sld As Slide
    Dim i As Long
    For Each sld In ActivePresentation.Slides
        For i = sld.Shapes.Count To 1 Step -1
            If sld.Shapes(i).Name Like "note*.wav" Then sld.Shapes(i).Delete
        Next i
    Next sld
End Sub

您要做的就是将以上所有代码复制到PPT的VBE编辑器中，并运行名为“ Add_TTS_Notes”的主宏。保存一些TTS声音文件会花费一些时间。

它将注释保存在所有幻灯片中的.wav文件中，将其插入到幻灯片中，并使它们在每张幻灯片上自动播放。工作完成后，您可以删除VBA代码并将ppt文件另存为.pptx或.ppsx，这比.pptm文件更方便，因为它不需要任何安全协议。

Answer 3

我正在使用PowerPoint 2016，就我而言，我需要按以下方式在SaveTTSWav函数中修改Konahn的代码。

将“说话者”作为新的SpeechLib.SpVoice

将oSpeaker设置为对象

oSpeaker = CreateObject（“ SAPI.Spvoice”）

＆

将oStream设置为新的SpeechLib.SpFileStream

将oStream设置为对象集

oStream = CreateObject（“ SAPI.SpFileStream”）

OnSlideShowPageChange未在演示文稿中运行

3 个答案: