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

Здесь я представляю МОЙ обходной путь, который может удовлетворить то, что вы хотите.

На самом деле, вы можете сохранить выше звука 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

Затем вставьте заметку (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

Все, что вам нужно сделать, это скопировать все коды выше наVBE-редактор вашего PPT и запустить основной макрос с именем "Add_TTS_Notes".Сохранение некоторых звуковых файлов TTS займет некоторое время.

Он сохранит заметки на всех слайдах в файлах .wav, вставит их на свои слайды и заставит автоматически воспроизводить их на каждом слайде.После выполнения задания вы можете удалить коды VBA и сохранить файл ppt в формате .pptx или .ppsx, который более удобен, чем файл .pptm, поскольку для него не требуется никакого соглашения о безопасности.

Answer 2

Чтобы получить текущий индекс слайдов, вы можете использовать следующее:

1. В Режим просмотра слайдов Режим: ActiveWindow.View.Slide.SlideIndex
2. В слайдПоказать режим : ActivePresentation.SlideShowWindow.View.Slide.SlideIndex

Для работы в режиме презентации измените

intSlide = ActiveWindow.Selection.SlideRange.SlideIndex

на

intSlide = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex

Примечаниечто это выдает ошибку, если не в режиме презентации.

EDIT : В упрощенном виде вы также можете сделать это:

Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)

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

End Sub