Home |
Search |
Today's Posts |
#1
![]() |
|||
|
|||
![]()
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 a 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: '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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
getting SCF code from ZIP Code | Excel Discussion (Misc queries) | |||
Help with Amending this Code Please | Excel Worksheet Functions | |||
Command Button VBA code | Excel Discussion (Misc queries) | |||
Often-Used Code not working in a new Workbook | Excel Discussion (Misc queries) | |||
Zip Code Macro | Excel Worksheet Functions |