How to close out of slideshow view at a given time/time interval in powerpoint VBA?

Question

I started VBA recently and am trying to make a project that will open up a powerpoint file(compute_dashboard.pptx) and put it up in slideshow view. It will go through the slides and loop until it reaches a specific time range; in this code below it should exit out at 10:10:00 AM - 10:10:10 AM and quit powerpoint. I have two different implementations each with their own problems, if you could find a way to correct either of them that would be great.

With my first implementation, it will open the file, then powerpoint doesn't respond until the clock reaches that time range, which then quits the application like it should. So the main problem is that I can't see the slideshow run at all.

    Sub OpenFile()
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    Set pptPres = pptApp.Presentations.Open("Compute_Dashboard.pptx")
    ActivePresentation.SlideShowSettings.Run

    Dim b As Boolean
    b = True
        While b = True
        If Time() > TimeValue("10:10:00") And Time() < TimeValue("10:10:10") Then
                b = False
                ActivePresentation.SlideShowWindow.view.Exit
                Application.Quit
        End If
            With ActivePresentation.Slides(1).SlideShowTransition
                    .AdvanceOnTime = msoTrue
                     .AdvanceTime = 3         
            End With 
        Wend

With the 2nd implementation, it opens the file and the slideshow loops correctly but then I can't get the slideshow and powerpoint to quit at my time range.


     Sub OpenFile()
     Set pptApp = CreateObject("PowerPoint.Application")
     pptApp.Visible = True
     Set pptPres = pptApp.Presentations.Open("Compute_Dashboard.pptx")
     ActivePresentation.SlideShowSettings.Run
     For Each s In ActivePresentation.Slides
         With s.SlideShowTransition
              .AdvanceOnTime = msoTrue
              .AdvanceTime = 3

      If Time() > TimeValue("10:10:00") And Time() < TimeValue("10:10:10") Then
                ActivePresentation.SlideShowWindow.view.Exit
                Application.Quit
      End If
      End With
     Next

Use your first set of code and pull your time-advancement code out of the while loop and only loop the time to quit portion of your code. The values you're setting for Advancement aren't triggering the advancement, just setting the time allotted BEFORE advancement. The second example fails because the If statement is triggered right after those settings are checked/set for each slide. Its not a continuous thing. It only happens the once(and for each slide) at that sub activation. — Mike

Mike Mike · Accepted Answer · 2019-07-03T18:46:46

Try this

Sub OpenFile()
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Open("Compute_Dashboard.pptx")
ActivePresentation.SlideShowSettings.Run
For Each s In ActivePresentation.Slides
     With s.SlideShowTransition
          .AdvanceOnTime = msoTrue
          .AdvanceTime = 3
     End With
Next s

Dim b As Boolean
b = True
    While b = True
    If Time() > TimeValue("10:10:00") And Time() < TimeValue("10:10:10") Then
            b = False
            ActivePresentation.SlideShowWindow.view.Exit
            Application.Quit
    End If
    Wend

I'm not 100% sure of your intent here - guessing you just want to set slide advancement time to 3 seconds for each slide and exit at a certain time.

Setting slide advancement time is not triggering the slide to advance. Its just setting that property for that slide - advance after 3 seconds.

Since it sets those properties for ALL slides in the blink of an eye at the time the program runs, it checks the QUIT requirements effectively the moment the program runs, thus never quitting.

How to close out of slideshow view at a given time/time interval in powerpoint VBA?

1 Answers