Hi all,
I have an xla application that includes a number of macros that I am
trying to Error-proof. I am particularly interested in doing so
because some other things I have going on in this app led me to employ
some of Dave Peterson's LockWindowUpdate code (details in the code
below). The first of the 3 macros below is an example of the macros I
am trying to error-proof (& the only error I am really concerned with
trapping is Error 18 which is supposed to be generated if the user
cancels), the other two are supporting macros that might be invoked.
I presently have coded for both Error 18 and Error 1004 (which is what
actually gets generated when I [ESC] from this procedure when Removing
Subtotals from a fairly large array of data). So the first of my two
questions are:
1) Can anyone can shed any light on why Error 18 isn't generated when
the user presses [ESC]?
and, more importantly,
2) When I execute this Remove Subtotals macro by stepping through it
(with the help of a Breakpoint), the MsgBox DOES display, allowing the
user to respond; but when I just run it from a toolbar button and press
[ESC] while the Selection.RemoveSubtotal is executing (again, on a
large enough array of data to let you press [ESC]), the macro just ends
WITHOUT displaying any MsgBox. Can anyone help me understand why this
works when stepping through it but not when executed normally?
Thanks!
Jeff
code follows:
Option Explicit
Private Declare Function LockWindowUpdate Lib "USER32" _
(ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "USER32" () As Long
Sub RemoveSubtotals()
'RemoveSubtotals Macro
Application.EnableCancelKey = xlErrorHandler
On Error GoTo handleCancel
If ActiveSheet.ProtectContents = False Then
Unprotected:
Application.StatusBar = "The more Subtotals there are in the
selected Region, the longer it takes to Remove Subtotals (large arrays
will take a while ...). Please wait ..."
Call WindowUpdating(False)
Selection.RemoveSubtotal
Application.StatusBar = False 'set StatusBar to "Ready"
Call WindowUpdating(True)
ElseIf ActiveSheet.ProtectContents = True Then
Call ProtectedSheetErrorHandler
'Test for protection again
If ActiveSheet.ProtectContents = False Then
'Worksheet is now unprotected so resume procedure above
Resume Unprotected
Else
Exit Sub
End If
End If
Exit Sub
handleCancel:
Call WindowUpdating(True)
Dim response As Integer
If Err.Number = 18 Or Err.Number = 1004 Then
response = MsgBox(prompt:="This message is appearing because
this function has been interrupted. Intentionally interrupting a" &
vbCrLf & "macro process may produce unexpected results. The specific
error that was triggered was:" & vbCrLf & vbCrLf & "Error Number: " &
Err.Number & " " & vbCrLf & "Error Description: " &
Err.Description & vbCrLf & vbCrLf & "To resume this process, click
'OK'. Otherwise, if you are sure you want to cancel, click Cancel to
end.", Buttons:=vbOKCancel)
Else
MsgBox "Error Number: " & Err.Number & vbCrLf & Err.Description
Exit Sub
End If
'If user clicks OK, then Resume; otherwise the process will end
If response <> vbCancel Then
Err = 0
Resume
End If
End Sub
'*************************************************************************************
Sub WindowUpdating(Enabled As Boolean)
'Courtesy of Dave Peterson email: [email protected]
'http://www.excelforum.com/printthread.php?s=&threadid=247463
' "Completely Locks the Whole Application Screen Area, including
dialogs and the mouse.
' You can turn off all of the windows screen updates -- but it this
code stops, you'll
' be rebooting your PC:"
Dim Res As Long
If Enabled Then
'Unlock screen area
LockWindowUpdate 0
Application.ScreenUpdating = True 'Not part of Dave's code
- I just added to be sure
Else
'Lock at desktop level
Res = LockWindowUpdate(GetDesktopWindow)
Application.ScreenUpdating = False 'Not part of Dave's code
- I just added to be sure
End If
End Sub
'*************************************************************************************
Public Sub ProtectedSheetErrorHandler()
Dim response, response2 As Integer
Call WindowUpdating(True)
response = MsgBox(prompt:="Worksheet is Protected - To perform this
function, you must Unprotect the Worksheet first." & Chr(13) & "Click
'OK' to Unprotect the Worksheet now or Cancel to end.",
Buttons:=vbOKCancel)
If response = vbCancel Then
'Worksheet is still protected, so advise
response2 = MsgBox(prompt:="Function NOT available because
Worksheet is Protected. Click OK to to continue.", Buttons:=vbOK)
Exit Sub
ElseIf response = vbOK Then
ActiveSheet.Unprotect
Exit Sub
End If
End Sub
Bookmarks