OnSlideShowPageChange 未在演示文稿中运行答案

【问题标题】：OnSlideShowPageChange not running in presentationOnSlideShowPageChange 未在演示文稿中运行
【发布时间】：2020-03-08 16:51:37
【问题描述】：

我的任务是构建一个自动化的幻灯片，以便在入职期间向新员工展示。我决定用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

【问题讨论】：

标签： vba powerpoint

【解决方案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

【讨论】：

啊，我明白了。这解决了，谢谢。但是我现在遇到了另一个问题。在实际更改为该幻灯片之前，它会讲述下一张幻灯片的注释，我应该使用 SlideShowNextSlide 事件吗？ PS，我确实给了这个投票，但我的声誉太低，无法展示。
SlideShowNextSlide 将具有相同的行为。来自文档：“在过渡到下一张幻灯片之前立即发生。”
这不是一种解决方法，但您可以将其更改为常规子例程并将其分配给幻灯片本身的操作按钮。

【解决方案2】：

这里我介绍一下MY work-around，可以满足你的需求。

其实你可以保存以上的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 文件更方便，因为它不需要任何安全协议。

【讨论】：

【解决方案3】：

我使用的是 PowerPoint 2016，就我而言，我需要在 SaveTTSWav 函数中修改 Konahn 的代码，如下所示。

'Dim oSpeaker 作为新的 SpeechLib.SpVoice

将 oSpeaker 作为对象集调暗

oSpeaker = CreateObject("SAPI.Spvoice")

'将 oStream 作为新的 SpeechLib.SpFileStream

将 oStream 作为对象集进行调光

oStream = CreateObject("SAPI.SpFileStream")

【讨论】：

Konanh 代码中的每一行都由 ' 字符注释（停用）。