How to interrupt live Clock loop for next slide transition?

178 views Asked by At

This is my first time ever programming something and I have managed to create a macro for a live clock on a Powerpoint (2016) presentation. The macro works perfectly, activating on my designated named slide only. However, I cannot find a way to interrupt the "Do Until clock=false" loop so that the presentation can advance to the next slide. The idea is for the presentation to be on a continuous loop so I need to macro to stop after the designated slide to avoid any lagging when cycling through.

I have tried to include a timevalue function to add a time onto the current time and give a place to stop, but this seems to have no effect.

Any help would be much appreciated!

Public clock As Boolean

Private Sub Pause()
Dim PauseTime, start
PauseTime = 1
start = Timer
Do While Timer < start + PauseTime
DoEvents
Loop
End Sub

Sub OnSlideshowPageChange(Wn As SlideShowWindow)

Dim currenttime, currenttimecount As Date
Dim currentdate, currentday As String

If Wn.View.Slide.Name = "autoclock 1" Then clock = True

Do Until clock = False
On Error Resume Next
If Weekday(Now) = 1 Then currentday = "Sunday"
If Weekday(Now) = 2 Then currentday = "Monday"
If Weekday(Now) = 3 Then currentday = "Tuesday"
If Weekday(Now) = 4 Then currentday = "Wednesday"
If Weekday(Now) = 5 Then currentday = "Thursday"
If Weekday(Now) = 6 Then currentday = "Friday"
If Weekday(Now) = 7 Then currentday = "Saturday"
currentdate = FormatDateTime(Now, vbLongDate)
currenttime = FormatDateTime(Now, vbLongTime)
currenttimecount = currenttime + TimeValue("00:00:10")
If currenttime = currenttimecount Then clock = False
If clock = False Then SlideShowWindows(1).View.Next
activepresentation.Slides(SlideShowWindows(1).View.CurrentShowPosition).Shapes("shpDayClockAuto").TextFrame.TextRange.Text = currentday & Space(20) & currentdate & Space(15) & currenttime
Pause
Loop

End Sub

Private Sub OnSlideshowTerminate(SW As SlideShowWindow)
clock = False
End Sub
0

There are 0 answers