演示文稿中没有 OnSlideShowPageChange 运行

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 的代码，如下所示。

'Dim oSpeaker As New SpeechLib.SpVoice

Dim oSpeaker As Object Set

oSpeaker = CreateObject("SAPI.Spvoice")

&

'Dim oStream As New SpeechLib.SpFileStream

Dim oStream As Object Set

oStream = CreateObject("SAPI.SpFileStream")

演示文稿中没有 OnSlideShowPageChange 运行

OnSlideShowPageChange not running in presentation

powerpoint

vba