Excel2002 & Trapping Esc key

[Tan]

I am on Excel 2002 and have a program that tries to trap the "Esc" key,
using
Application.EnableCancelKey = xlErrorHandler
and trapping error 18:
If Err.Number = 18 Then

The program is called from a modal form.

The problem is that if the form has ShowModal=True, the Esc key cannot be
trapped; while if the ShowModal of the form is False, then the system can
trap the Esc key.

Control Break has no problem - ie it is trappable.

Any idea on how I can have a ShowModal=True form and yet, trap the esc key?




Private Sub ExampleOfHow2HandleTheUserPressingCANCEL()
Dim iTest As Double, iCount As Double
On Error GoTo err_Sub

'xlDisabled = 0 'totally disables Esc / Ctrl-Break / Command-Period
'xlInterrupt = 1 'go to debug
'xlErrorHandler = 2 'go to error handler
'Trappable error is #18
Application.EnableCancelKey = xlErrorHandler


'<<<<<<<<<<<<<<PUT YOUR CODE HERE>>>>>>>>>>>>

exit_Sub:
On Error Resume Next
Exit Sub

err_Sub:
If Err.Number = 18 Then
If MsgBox("You have stopped the process." & vbCr & vbCr & _
"QUIT now?", vbCritical + vbYesNo + vbDefaultButton1, _
"User Interrupt Occured...") = vbNo Then
Resume 'continue on from where error occured
End If
End If

GoTo exit_Sub

End Sub

 

[Ron de Bruin]

Maybe ?

You can add a button and set cancel to True
When you hit esc the code from the button will run.

 

[Tan]

Thanks, but it doesn't work. I create a Cancel button and set cancel to be
true, with a little piece of code that says "msgbox ("Cancel pressed")". But
when I press the esc button, the message did not appear (ie, the code from
the cancel button did not execute. Any idea on how to resolve this?

 

[Ron de Bruin]

Hi Tan

Working for me with ShowModal True and False

 

[Peter T]

In theory xlErrorHandler should trap Esc but it rarely does. But I find the
method flakey, sometimes need to press Ctr-Break many times for it to catch.
This gives a bit more control & flexibility

Option Explicit
Public Declare Function GetInputState _
Lib "user32" () As Long
Public Declare Function GetAsyncKeyState _
Lib "user32" _
(ByVal vKey As Long) As Integer

Function IsKeyDown(key As Long) As Boolean
If GetAsyncKeyState(key) Then
IsKeyDown = True
End If
End Function

Function EscBreak() As Long

If IsKeyDown(vbKeyCancel) Then
EscBreak = vbKeyCancel '3
ElseIf IsKeyDown(vbKeyPause) Then
EscBreak = vbKeyPause '19
ElseIf IsKeyDown(vbKeyEscape) Then
EscBreak = vbKeyEscape '27
End If

End Function

Function UserBreak(nKeyPress As Long, Optional _
sInfo As String) As Boolean

Dim nEnblCancel As Long
Dim nScrUdate As Boolean
Dim sPrompt As String
Debug.Print "UserBreak1", Application.EnableCancelKey
nEnblCancel = Application.EnableCancelKey
nScrUdate = Application.ScreenUpdating

On Error GoTo errH:
Application.ScreenUpdating = True
Application.EnableCancelKey = xlErrorHandler

Select Case nKeyPress
Case 3: sPrompt = "Ctrl Break with API"
Case 18: sPrompt = "Ctrl Break xlErrorHandler"
Case 19: sPrompt = "Break without Ctrl"
Case 27: sPrompt = "Esc"
Case Else: '?
End Select
If Len(sInfo) Then
sPrompt = sInfo & vbCr & vbCr & sPrompt
End If

If MsgBox(sPrompt & vbCr & "continue :?", vbYesNo) = vbYes Then
UserBreak = True
End If

errH:
Application.EnableCancelKey = nEnblCancel
Application.ScreenUpdating = nScrUdate
End Function

Sub Test()
Dim i As Long, j As Long, cnt As Long
Dim nOuter As Long, nInner As Long
Dim nKey As Long
Dim s1$, s2$, sMsg$

s1 = "some test to a string"
nOuter = 5000
nInner = 1000
On Error GoTo errH
Application.EnableCancelKey = xlErrorHandler
For i = 1 To nOuter
For j = 1 To nInner
cnt = cnt + 1
s2 = cnt & " " & Left$(s1, 5) & Right$(s1, 6)
Next

Application.StatusBar = nOuter * nInner & " / " & cnt

If GetInputState Then
'GetInputState - v.quick check if some key pressed

nKey = EscBreak
If nKey > 0 Then
Err.Raise 12345
End If
End If
Next
s2 = s2 & " completed"
cleanup:
MsgBox s2
Application.EnableCancelKey = xlInterrupt
Application.StatusBar = False
Exit Sub

errH:
sMsg = ""
If Err.Number = 18 Then nKey = 18

If nKey > 0 Then
If UserBreak(nKey, _
Int(cnt * 100 / (nOuter * nInner)) & "% done") Then
Resume Next
End If
Else
MsgBox Err.Number & " " & Err.Description
End If

Resume cleanup

End Sub



Ron,
I think for your Esc to Cancel button event to work within a loop might need
to add DoEvents

Regards,
Peter T