Here's some VBA code you can add to a PowerPoint presentation. Copy/paste this to Notepad and save with the filename "speechmodule.cls" or download the file from here.
Option Explicit
Public fRunning As Boolean
Public WithEvents App As ApplicationPublic WithEvents Voice As SpVoicePublic WithEvents reco As SpSharedRecoContext
Private m_gram As ISpeechRecoGrammarPrivate m_dict As ISpeechRecoGrammar
Private Sub AddNumberPron(num As Long) 'TODOEnd Sub
Public Sub DictationStart() If m_dict Is Nothing Then Set m_dict = reco.CreateGrammar m_dict.DictationLoad End If m_dict.DictationSetState SGDSActiveEnd Sub
Public Sub DictationEnd() m_dict.DictationSetState SGDSInactiveEnd Sub
Private Sub App_SlideShowBegin(ByVal Wn As SlideShowWindow) m_gram.Reset Dim rule As ISpeechGrammarRule Set rule = m_gram.Rules.Add("goto", SRADefaultToActive + SRATopLevel) Dim Slide As Slide Dim i% i = 0 For Each Slide In ActivePresentation.Slides i = i + 1 rule.InitialState.AddWordTransition Nothing, "go to " & Slide.Shapes.Title.TextFrame.TextRange.Text & " ?please", , , "PAGE", , i Next Slide
rule.InitialState.AddWordTransition Nothing, "first page ?please", , , "PAGE", , 1 rule.InitialState.AddWordTransition Nothing, "last page ?please", , , "PAGE", , i rule.InitialState.AddWordTransition Nothing, "previous page ?please", , , "PAGE", , "-1" rule.InitialState.AddWordTransition Nothing, "next page ?please", , , "PAGE", , "+1" ' Set rule = m_gram.Rules.Add("input", SRADefaultToActive + SRATopLevel)' rule.InitialState.AddWordTransition Nothing, "input", , , "INPUT" m_gram.Rules.Commit m_gram.CmdSetRuleState "", SGDSActive reco.State = SRCS_Enabled If Not m_dict Is Nothing Then m_dict.State = SGSEnabled End Sub
Private Sub App_SlideShowEnd(ByVal Pres As Presentation) Voice.Speak "", SVSFlagsAsync + SVSFPurgeBeforeSpeak fRunning = False reco.State = SRCS_Disabled If Not m_dict Is Nothing Then m_dict.State = SGSDisabledEnd Sub
Private Sub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow) Dim shp As shape 'Voice.Speak Wn.View.Slide.Shapes.Title.TextFrame.TextRange.Text, SVSFlagsAsync + SVSFPurgeBeforeSpeak Voice.Speak "", SVSFlagsAsync + SVSFPurgeBeforeSpeak For Each shp In Wn.View.Slide.Shapes On Error Resume Next Voice.Speak shp.TextFrame.TextRange.Text, SVSFlagsAsync On Error GoTo 0 Next shpEnd Sub
Private Sub Class_Initialize() Set reco = New SpSharedRecoContext Set Voice = reco.Voice Set m_gram = reco.CreateGrammar End Sub
Private Sub reco_Recognition(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal RecognitionType As SpeechLib.SpeechRecognitionType, ByVal Result As SpeechLib.ISpeechRecoResult) If Result.PhraseInfo.rule.Name = "" And Result.PhraseInfo.rule.Id = 0 Then ' Dictation 'App.ActivePresentation.SlideShowWindow.View.Slide.Shapes Slide1.TextBox1.SelText = Result.PhraseInfo.GetText & " " Else Dim prop As ISpeechPhraseProperty For Each prop In Result.PhraseInfo.Properties Select Case prop.Name Case "PAGE" If prop.Value = "+1" Then App.ActivePresentation.SlideShowWindow.View.Next ElseIf prop.Value = "-1" Then App.ActivePresentation.SlideShowWindow.View.Previous Else App.ActivePresentation.SlideShowWindow.View.GotoSlide prop.Value End If Case "INPUT" Case Else End Select Next prop End IfEnd Sub
Private Sub Voice_Word(ByVal StreamNumber As Long, _ ByVal StreamPosition As Variant, _ ByVal CharacterPosition As Long, _ ByVal Length As Long) Debug.Print CharacterPosition, LengthEnd Sub