Run Complete PowerPoint Slide Show from Visual Basic

The following VB subroutine shows how to start a PowerPoint slide show. After starting the slide show, it monitors the show and returns when the show ends.

See Also: StartSlideShow

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const RPC_E_CALL_REJECTED = &H80010001

Sub RunSlideShow(ByVal FileName As String)
    Dim PPT As Object
    Dim Pres As Object
    Dim SSW As Object
    Dim State As Long

    On Error Resume Next

    Set PPT = CreateObject("PowerPoint.Application")
    Set Pres = PPT.Presentations.Open(FileName, False, False, False)
    Set SSW = Pres.SlideShowWindow
    If SSW Is Nothing Then
        Set SSW = Pres.SlideShowSettings.Run
    End If

    State = SSW.View.State
    Err.Clear
    Do While (Err.Number = RPC_E_CALL_REJECTED) Or (Err.Number = 0)
        DoEvents
        Sleep 1000
        State = SSW.View.State
    Loop

    Pres.Close
    PPT.Quit

    Set Pres = Nothing
    Set PPT = Nothing
End Sub

Contact OfficeOne on email at officeone@officeoneonline.com. Copyright © 2001-2023 OfficeOne. All rights reserved.