problem capturing Run-Time error 18

[Legacy 146544]

Hi all,


Im am creating a powerpoint like presentation in excel. The presentation is invoked by button click and I need to capture the error variable when ESC is pressed. This practical use of it is: the excel document should run on a tv screen, showing each page about 30 seconds. I need the code to be cancelled when the user presses ESC.

For testing purposes I have added the for x = 1 to 2 in the code below. In fact it should run infinitely until cancelled by ESC. When I press ESC on this code; Excel rushes through entire rest of the loop (for-next, I have also tried with do-loop) instead of reaching the errorstatement.

This is my code:

Private Sub CommandButton2_Click()

On Error GoTo UserInterrupt
Application.EnableCancelKey = xlErrorHandler

Dim Uur As Variant
Dim Minuut As Variant
Dim Seconde As Variant
Dim WachtTot As Variant
Dim x As Integer, SecPerPag As Integer, TotaalTijd As Integer

SecPerPag = Blad22.Range("D4").Value

Application.DisplayFullScreen = True

For x = 1 To 2
Blad11.Activate
Uur = Hour(Now())
Minuut = Minute(Now())
Seconde = Second(Now()) + SecPerPag
WachtTot = TimeSerial(Uur, Minuut, Seconde)
Application.Wait WachtTot

Blad12.Activate
Uur = Hour(Now())
Minuut = Minute(Now())
Seconde = Second(Now()) + SecPerPag
WachtTot = TimeSerial(Uur, Minuut, Seconde)
Application.Wait WachtTot

Blad13.Activate
Uur = Hour(Now())
Minuut = Minute(Now())
Seconde = Second(Now()) + SecPerPag
WachtTot = TimeSerial(Uur, Minuut, Seconde)
Application.Wait WachtTot

Blad15.Activate
Uur = Hour(Now())
Minuut = Minute(Now())
Seconde = Second(Now()) + SecPerPag
WachtTot = TimeSerial(Uur, Minuut, Seconde)
Application.Wait WachtTot

Blad19.Activate
Uur = Hour(Now())
Minuut = Minute(Now())
Seconde = Second(Now()) + SecPerPag
WachtTot = TimeSerial(Uur, Minuut, Seconde)
Application.Wait WachtTot

Next x
Application.DisplayFullScreen = False
Exit Sub

UserInterrupt:
If Err.Number = 18 Then
Application.DisplayFullScreen = False
Exit Sub
End If

End Sub

Who knows why pressing ESC does not make the procedure go to the errorhandling statement?

 

[daverunt]

I think on infinite loops this might be normal but I'm no expert.

have a look here. It might help with a solution.

http://www.oaltd.co.uk/Excel/Default.htm

CheckKey.zip

 

[Legacy 146544]

Thx a lot for your response.

I've worked around the problem for now, but will definitely check your suggestion to improve my code!

Cheers