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
You can add a button and set cancel to True
When you hit esc the code from the button will run.
--
Regards Ron de Bruin
http://www.rondebruin.nl
"Tan" <T...@discussions.microsoft.com> wrote in message news:E81EB567-C14B-4E30...@microsoft.com...
Working for me with ShowModal True and False
--
Regards Ron de Bruin
http://www.rondebruin.nl
"Tan" <T...@discussions.microsoft.com> wrote in message news:2B428834-5517-41FE...@microsoft.com...
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
"Tan" <T...@discussions.microsoft.com> wrote in message
news:2B428834-5517-41FE...@microsoft.com...