Program Powerpoint to change slides with voice commands

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 Application
Public WithEvents Voice As SpVoice
Public WithEvents reco As SpSharedRecoContext

Private m_gram As ISpeechRecoGrammar
Private m_dict As ISpeechRecoGrammar

Private Sub AddNumberPron(num As Long)
    'TODO
End Sub

Public Sub DictationStart()
    If m_dict Is Nothing Then
        Set m_dict = reco.CreateGrammar
        m_dict.DictationLoad
    End If
    m_dict.DictationSetState SGDSActive
End Sub

Public Sub DictationEnd()
    m_dict.DictationSetState SGDSInactive
End 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 = SGSDisabled
End 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 shp
End 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 If
End Sub

Private Sub Voice_Word(ByVal StreamNumber As Long, _
                        ByVal StreamPosition As Variant, _
                        ByVal CharacterPosition As Long, _
                        ByVal Length As Long)
    Debug.Print CharacterPosition, Length
End Sub