Making a fake screensaver in PPT using VBA - vba

Question

I'm trying to mimic a screensaver on PowerPoint that will return to my first slide after X amount of seconds of inactivity.
The PowerPoint presentation is all just completely image based and every click will transition through the slides, so it doesn't have to be sophisticated at all, just that at the start of each slide it counts down 5 seconds, then returns to slide 1 (which is my fake screensaver page).
I've already got something working in a basic format, it takes you to the first page after 5 seconds, but the timer doesn't restart once you go to a new slide, once it starts counting down, regardless of if you move to the next slide after 3 seconds, you don't get another 5 second countdown, it just finishes the remaining 2 seconds and redirects you.
VBA is definitely not my primary language, I'm just piecing this together with what I can find, but my current code is below
Sub Auto_NextSlide(Index As Long)
Dim Delay, Start
If Index > 1 Then
Delay = 5
Start = Timer
Do While Timer < Start + Delay
DoEvents
Loop
SlideShowWindows(1).View.GotoSlide (SlideShowWindows(1).Presentation.Slides(1).SlideIndex)
End If
End Sub

Answer 1

Try maybe something like below (using class events)
' AppEvents class module
Option Explicit
Public WithEvents App As Application
Const Delay As Integer = 5
Dim Start
Dim actualSlide As Integer
Private Sub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
With Wn.Presentation.SlideShowWindow
Start = Timer
actualSlide = .View.Slide.SlideIndex
If actualSlide > 1 Then
Do While Timer < Start + Delay
DoEvents
If .View.Slide.SlideIndex <> actualSlide Then
Start = Timer
actualSlide = .View.Slide.SlideIndex
End If
Loop
.View.GotoSlide (.Presentation.Slides(1).SlideIndex)
End If
End With
End Sub
Module code
' Module 1
Option Explicit
Public pApp As AppEvents
Sub GetAppClass()
Set pApp = New AppEvents
Set pApp.App = Application
ActivePresentation.SlideShowSettings.Run
End Sub