VBA stuck in loop

[Gary T]

Hi Guys,
I have created a clock (Using code I managed to find online) on a PowerPoint slide that works fine using the Mouse over option however as it is only a single slide used on a reception screen I would like to automate the start clock as some people forget to start it

I have used the following code which starts the clock however If I exit the Slideshow using the esc button PowerPoint freezes
What do I need to change to stop this happening. Thanks for any assistance


Public clock As Boolean
Public currenttime, currentday As String

-----------------------------------------------------------------------------------------------------------------------------------------
Sub Pause()
Dim PauseTime, start
PauseTime = 1
start = Timer
Do While Timer < start + PauseTime
DoEvents
Loop
End Sub
-----------------------------------------------------------------------------------------------------------------------------------------
Sub StartClock()
clock = True
Do Until clock = False
On Error Resume Next
currenttime = Format((Now()), "DDDD DD MMMM hh:mm:ss")
ActivePresentation.Slides(SlideShowWindows(1).View.CurrentShowPosition).Sha pes("shpClock").TextFrame.TextRange.Text = currenttime
Pause
Loop
End Sub

----------------------------------------------------------------------------------------------------------------------------------------------
Sub OnSlideShowTerminate()
clock = False

End Sub
------------------------------------------------------------------------------------------------------------------------------------------------
Sub OnSlideShowPageChange()
Dim i As Integer
i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
If i <> 1 Then Exit Sub
StartClock

End Sub