VBA Code


SlideShowWindows Collection

This is a collection of all the slide show windows in PowerPoint.


Code to exit all running slide shows

Do While SlideShowWindows.Count > 0 
   SlideShowWindows(1).View.Exit
Loop

Refreshes the current slide during a slide show

Dim iSlideIndex As Integer 
iSlideIndex = SlideShowWindows(1).View.CurrentShowPosition
SlideShowWindows(1).View.GotoSlide(iSlideIndex)

Code to reset animation build for the current slide during a slide show

Dim iSlideIndex As Integer 
iSlideIndex = SlideShowWindows(1).View.CurrentShowPosition
SlideShowWindows(1).View.GotoSlide(iSlideIndex, True)


Application.SlideShowWindows(1).View.Slide.Shapes.AddTextBox(OrientationHorizontal, 50 , 540 , 50 ,50).TextFrame.TextRange.Text = "some text" 


Running a SlideShow

Use the Run method of the SlideShowSettings property to create a new slide show.
This is automatically added to the SlideShowWindows collection.

Application.SlideShowSettings.Run 


This sets the slide show in window one to the first slide in the presentation

Application.SlideShowWindows(1).View.First 

Use the View property to return the SlideShowView object the window contains
The following changes the pointer to a pen and sets the pen colour for the slide show to red

With Application.ActivePresentation.SlideShowSettings.Run.View 
   .PointerColor.RGB = RGB(255,0,0)
   .PointerType = ppSlideShowPointerPen
End With


If you have 2 presentations open but only one of them running as a slide show, the following line of code would return:
Presentations 2, Slide Shows 1

Call MsgBox "Presentations " & Application.Presentations.Count & _ 
            "Slide Shows " & Application.SlideShowWindows.Count


Though "Run" is the only method really necessary to launch a slide show, some of the SlideShowSettings properties might be worth taking a closer look at as well:
ShowType: sets the show type for the specified slide show...(kiosk, speaker, window).
StartingSlide: sets the first slide to be displayed in the specified slide show.
EndingSlide: sets the last slide to be displayed in the specified slide show.



Custom slide shows:

We can also create custom slide shows based upon an existing presentation and specify which of the presentation's slides needs to be part of the custom slide show (in the PowerPoint menu > "Slide Show" > "Custom Shows"). Assuming "MyPresentation" is open in edit mode and does hold at least 5 slides, next code will create and launch a custom slide show based upon only 3 of the slides of the original presentation (slides 1 and 4 are excluded):

Dim SlArr(3) As Long 
 
With Presentations("MyPresentation")
     
'Add the slide ID's to an array.
    SlArr(1) = .Slides(2).SlideID
    SlArr(2) = .Slides(3).SlideID
    SlArr(3) = .Slides(5).SlideID
     
'Add, create and name the custom show, and set the type of show that needs to be shown.
    With .SlideShowSettings
        .NamedSlideShows.Add "MyCustomShow", SlArr
        .RangeType = ppShowNamedSlideShow
        .SlideShowName = "MyCustomShow"
        .Run
    End With
     
End With

Note that after running the above piece of code we will be prompted to save changes when closing "MyPresentation" since a custom show has been added to the presentation's "NamedSlideShows" collection.


Presentations("MyPresentation").NamedSlideShows("MyCustomShow").Delete 

Although you can refer to a custom slide show by its index number, referring to it by its name is a much safer way.


When applied on a running slide show, the "Close" method will not only stop the slide show, but also close both the presentation's "slide show" and "edit" window, in other words close the entire presentation. The "Exit" method on the other hand will stop a running slide show but not close the presentation's edit window. One remark though, when applied on a pps file opened by double clicking or the "Presentations.Open" method, both "Close" and "Exit" will have the same effect, i.e. stop and close the running slide show.


With Presentations("MyPresentation") 
'First run.
    .SlideShowSettings.Run
    MsgBox "Exit show"
'Force the show back in "edit" mode.
    .SlideShowWindow.View.Exit
     
'Second run.
    .SlideShowSettings.Run
    MsgBox "Close show"
'Close both the show and the presentation's edit window.
    .Close
End With

Detecting when a slide show has finished:

In case we would create and/or launch a slide show from another application, it sometimes might be useful to know when the slide show we started has ended or been closed manually. The following procedure which invokes some API, will detect when a launched slide show has come to an end and give the focus back to the application which has called it.
A procedure which can be called like this:


ResumeWhenDone "C:\MyPresentation.ppt", 5 

 'The timeGetTime function retrieves the system time, in milliseconds.
'The system time is the time elapsed since Windows was started.
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
'The Sleep function suspends the execution of code for the specified interval (in milliseconds).
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'Note that these API functions needs to be declared in a module.
 
Sub ResumeWhenDone(PresFullName As String, MaxMinutes As Integer)
'"MaxMinutes" is the maximum time (in minutes) the show is allowed to run.
'If not closed by the user within this time, the show will be closed code wise.
    Dim StrT As Long, RunT As Double, i As Integer
    Dim PP As PowerPoint.Application, PPRunning As Boolean
    Dim Pres As PowerPoint.Presentation, PresMsg As Boolean
     
    On Error Resume Next
    Set PP = GetObject(Class:="PowerPoint.Application")
    On Error Goto AppErr
     
    If Not PP Is Nothing Then
        PPRunning = True
    Else
        Set PP = New PowerPoint.Application
    End If
     
    Set Pres = PP.Presentations.Open(FileName:=PresFullName, WithWindow:=False)
     
    StrT = timeGetTime
     
    On Error Goto PresErr
     
'Make the application visible and start the slide show.
'Making the application visible after the presentation is opened, will prevent us from
'seeing the application window first in case opening of the presentation would take some time.
    PP.Visible = True
    Pres.SlideShowSettings.Run
     
    Do
        On Error Resume Next
'Check one of the presentation's properties, and as long this check does
'not result in an error we know the show is still running.
        i = Pres.SlideShowSettings.ShowType
         
'Calculate the time elapsed since the show is running, in minutes.
        RunT = ((timeGetTime - StrT) / 1000) / 60
         
'If the presentaion is closed by the user.
        If Err.Number <> 0 Then Err.Clear: Goto AppErr
'If "MaxMinutes" is exceeded.
        If (Int(RunT) >= Int(MaxMinutes)) Then Goto PresErr
         
        DoEvents
        Sleep 10
    Loop
     
PresErr:
    Pres.Close
     
    If Err.Number <> 0 Then PresMsg = True
     
AppErr:
    If (Not PP Is Nothing) And (PPRunning = False) Then PP.Quit
     
    Set Pres = Nothing
    Set PP = Nothing
     
    If Err.Number = 0 Then Exit Sub
     
    If PresMsg Then
        MsgBox "A problem occurred while running the slide show. " & vbCrLf & _
        "Due to this problem, the slide show is closed. ", vbExclamation, "May I have your attention please..."
    Else
        MsgBox "PowerPoint is possibly not installed on your system, " & vbCrLf & _
        "or the presentation you wish to open could not be opened. ", vbExclamation, "May I have your attention please..."
    End If
     
End Sub



© 2020 Better Solutions Limited. All Rights Reserved. © 2020 Better Solutions Limited TopPrevNext