I would like to prevent a user from stopping a macro during saving.
I have found the following code :
Application.EnableCancelKey = xlDisabled
It works if you hit the ESC key once, but if you hold the key a long time you can stop the macro.
I tried Application.EnableCancelKey = xlErrorHandler as follow :
Application.EnableCancelKey = xlErrorHandler
On Error GoTo errHandler:
ActiveWorkbook.Save
exitHere:
Exit Sub
errHandler:
msgbox"something"
Resume exitHere
Sometime it works perfectly, but sometimes if I hit the ESC key at the perfect moment and for a few seconds, I am able to stop the macro.
Do you know if there is a way to inactive ESC key for real?
I've never done this, but this is how I would start from your code:
On Error GoTo errHandler:
Application.EnableCancelKey = xlErrorHandler
ActiveWorkbook.Save
Application.EnableCancelKey = xlInterrupt
exitHere:
Exit Sub
errHandler:
If MsgBox("something", vbOKCancel) = vbCancel Then
Application.EnableCancelKey = xlInterrupt
Exit Sub
End If
Resume
Related
After the new document is created (documents.add), the macro pass ends.
I tried the documents.add with parameter (visible:=false) but no effect.
Sub beispiel()
Dim objDokQuelle As Document
Dim objDokZiel As Document
On Error GoTo FEHLER
Set objDokQuelle = ActiveDocument
Set objDokZiel = Documents.Add 'This is the last line to be processed; then the macro terminates
'The following lines are not processed
objDokQuelle.Activate
Selection.WholeStory
Selection.Copy
objDokZiel.Activate
Selection.Paste
FEHLER:
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical + vbOKOnly, "Error ..."
End If
End Sub
I don't understand what is wrong in this Code, so the macro terminates at the commented line. There are no error Messages.
Thanks for help.
I currently have this, but I dont necessarily need a loop. I just need to see if there is any error in the usedrange, and if yes, stop the code and display the message. If no error, then just continue with the rest of the steps that are after this part of the code. Right now this loop displays this message for every error detected. I just need it to be displayed once if any error is found, and then stop the code.
Dim r As Range
For Each r In ws_DST.UsedRange
If IsError(r.Value) Then
MsgBox "Please fix any errors", vbOKOnly
End If
Next
End
How about:
Sub errortest()
On Error Resume Next
Set Rng = Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
If Rng Is Nothing Then
Exit Sub
Else
For Each r In Rng
MsgBox r.Address(0, 0)
Next r
End If
End Sub
I have to change several defaults which my macro fixes at the end, but if I need to interrupt the macro, the settings will not be reset.
So if the code contains
Application.Calculation = xlCalculationManual
then I would have
Private Sub IfInterrupted()
Application.Calculation = xlCalculationAutomatic
End Sub
Is there any way to do this?
If you really really need to do this, then this is how:
Sub YourSub()
On Error GoTo ErrHandler:
Application.EnableCancelKey = xlErrorHandler
' You code goes here
ErrHandler:
With Err
If .Number <> 18 Then
.Raise .Number, .Source, .Description, .HelpFile, .HelpContext
End If
End With
Application.Calculation = xlCalculationAutomatic
End Sub
However, there are better ways to achieve whatever it is you are trying to achieve. For example, polling for user input.
Using the following code to auto upper two columns,
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Application.Intersect(Target, Range("C2:C5000", "P3:P5000")) _
Is Nothing) Then
With Target
Application.EnableEvents = False
.Value = UCase(.Value)
Application.EnableEvents = True
End With
End If
End Sub
Works perfectly, the problem is, if a user selects multiple cells, and hits delete, it errors, then the user hits End and the function no longer works. protected. Run-time error 13, type mismatch.
Doesn't matter if the cell is empty or not, still get the error.
Thanks in advance.
The answer of #ScottHoltzman solves the issue of the current problem, where an error is raised when you apply UCASE to an Array. When the Target range has more than one cell its .Value is an array, and UCase does not accept an array parameter.
Your routine will exit this line (.Value = UCase(.Value)) and will miss the next line that resets Application.EnableEvents = True. After that, you end up working with events disabled, so all your event handling routines will stop working, not only this one (in case you had other such routines).
To avoid these situations the good approach is to implement proper error handling in event handlers, following this structure
Sub my_Handler()
On Error Goto Cleanup
Application.EnableEvents = False: Application.ScreenUpdating = False ' etc..
''''''''''''''''''''''''''''''''''
'
' normal code of the routine here
'
''''''''''''''''''''''''''''''''''
Cleanup:
if Err.Number <> 0 Then MsgBox Err.Description
Application.EnableEvents = True, Application.ScreenUpdating = True ' etc..
End Sub
To apply it to your routine:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Cleanup
Application.EnableEvents = False: Application.ScreenUpdating = False ' etc..
If Not (Application.Intersect(Target, Range("C2:P5000")) Is Nothing) Then
Target.value = UCase(Target.value)
End If
Cleanup:
If Err.Number <> 0 Then msgBox Err.Description
Application.EnableEvents = True: Application.ScreenUpdating = True ' etc..
End Sub
Importantly, don't use this structure automatically for all you routines, only Event handlers or eventually macros ythat you would invoke from the GUI. Other routines are usually called from these handlers or macros, so you can write them normally.
I tried putting this in a comment to the answer, but was too long, so sorry..
#a-s-h #a.s.h
This one worked the best, with a slight modification. Thanks!
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Cleanup
Application.EnableEvents = False: Application.ScreenUpdating = False ' etc..
If Not (Application.Intersect(Target, Range("C2:C5000", "P3:P5000")) Is Nothing) Then
Target.Value = UCase(Target.Value)
End If
Cleanup:
If Err.Number <> 0 Then GoTo EndLine
EndLine:
Application.EnableEvents = True: Application.ScreenUpdating = True ' etc..
End Sub
Performs uppercase, and deletes multiples at once without any errors, or MsgBox's.
If they are selecting multiple cells then my thinking is that you would want to use SelectionChange macro instead, like this
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
If ((Target.Address = Target.EntireRow.Address Or _
Target.Address = Target.EntireColumn.Address)) Then Exit Sub
Application.EnableEvents = False
If Not (Application.Intersect(Target, Range("C2:C5000", "P3:P5000")) _
Is Nothing) Then
On Error GoTo endItAll
For Each aCell In Target.Cells
Range(aCell.Address) = UCase(Range(aCell.Address))
Next aCell
End If
endItAll:
Application.EnableEvents = True
SecondsElapsed = Round(Timer - StartTime, 2)
Debug.Print SecondsElapsed
End Sub
Or you could change it back to the worksheet_Change macro like below and it will not error if the user selects multiple cells or deletes cells without causing an error. The error handler is there - Like in A.S.H. 's solution, but I haven't yet seen it needed in my testing.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not (Application.Intersect(Target, Range("C1:C5000", "D1:D5000")) _
Is Nothing) Then
On Error GoTo endItAll
For Each aCell In Target.Cells
Range(aCell.Address) = UCase(Range(aCell.Address))
Next aCell
End If
endItAll:
Application.EnableEvents = True
End Sub
Account for multiple cells this way:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Application.Intersect(Target, Range("C2:C5000", "P3:P5000")) _
Is Nothing) Then
Dim rCell as Range
Application.EnableEvents = False
For each rCell in Target
rCell.Value = UCase(rCell.Value)
Next
Application.EnableEvents = True
End If
End Sub
I am trying to get multiple on error statements to work and can't figure it out.
If pdf can be found in local then open, if not then open network location. If there is no PDF in then return msgbox.
Sub Cutsheets()
Application.ScreenUpdating = False
Dim finalrow As Integer
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
On Error GoTo net1
If Not Application.Intersect(ActiveCell, Range("A9:A" & finalrow)) Is Nothing Then
'Local Location
ActiveWorkbook.FollowHyperlink "C:\Local" & ActiveCell & ".pdf"
Application.SendKeys "{ENTER}", True
End If
Exit Sub
net1:
If Not Application.Intersect(ActiveCell, Range("A9:A" & finalrow)) Is Nothing Then
'Network Location
On Error GoTo whoa
ActiveWorkbook.FollowHyperlink "P:\Network" & ActiveCell & ".pdf"
Application.SendKeys "{ENTER}", True
End If
Exit Sub
whoa:
MsgBox ("No cutsheet can be found for this item.")
Application.ScreenUpdating = True
End Sub
Also I don't remember why I put sendkeys in there but it doesn't work without it.
Using multiple On Error Goto XYZ handlers for control flow is over-complicating some easy validation checks you can do and then simply use the error handling for actual errors.
As #Rory pointed out in a comment you can use the Dir function. You can combine the use of Dir with an If...ElseIf...Else...End If construct to control what you code does:
Option Explicit
Sub Cutsheets()
On Error GoTo ErrHandler
Dim strLocalCheck As String
Dim strNetworkCheck As String
'check for files - Dir will return "" if file not found
strLocalCheck = Dir("C:\Local" & ActiveCell.Value & ".pdf")
strNetworkCheck = Dir("P:\Network" & ActiveCell.Value & ".pdf")
'control flow
If strLocalCheck <> "" Then
ActiveWorkbook.FollowHyperlink strLocalCheck
Application.SendKeys "{ENTER}", True
ElseIf strNetworkCheck <> "" Then
ActiveWorkbook.FollowHyperlink strNetworkCheck
Application.SendKeys "{ENTER}", True
Else
MsgBox "No cutsheet can be found for this item."
End If
Exit Sub
ErrHandler:
Debug.Print "A real error occurred: " & Err.Description
End Sub
I am trying to get multiple on error statements to work
Don't.
Imagine you're the VBA runtime. You're executing a procedure called Cutsheets, and you come across this instruction:
On Error GoTo net1
From that point on, before you blow up in the user's face, you're going to jump to the net1 label if you ever encounter a run-time error. So you keep running instructions. Eventually you run this line:
ActiveWorkbook.FollowHyperlink "C:\Local" & ActiveCell & ".pdf"
And when the FollowHyperlink method responds with "uh nope, can't do that" and raises a run-time error, your execution context changes.
You're in "error handling" mode.
So you jump to the net1 label. You're in "error handling" mode. There are certain things you can do in "normal execution mode" that you can't (or shouldn't) do in "error handling mode". Raising and handling more errors is one of these things.
On Error GoTo whoa
You're already handling a run-time error: what should you do when you encounter that statement in an error handler subroutine? Jump to the whoa right away?
When the VBA runtime is in "error handling mode", your job as a programmer is to handle runtime errors and do everything you can to get back to "normal execution mode" as soon as possible - and that's normally done with a Resume instruction, or by leaving the current scope.
Copying a chunk of code from the "normal execution path" and trying to run it (slightly altered) in "error handling mode" isn't handling errors and getting back to normal execution mode as soon as possible.
Error handling or not, copy-pasting chunks of code is poorly written code anyway.
Extract a procedure instead:
Private Sub OpenPortableDocumentFile(ByVal path As String)
On Error GoTo ErrHandler
ActiveWorkbook.FollowHyperlink path
Application.SendKeys "{ENTER}", True
Exit Sub
ErrHandler:
MsgBox "Could not open file '" & path & "'."
End Sub
Now that that's out of the way, clean up your control flow by verifying if the file exists before you pass an invalid path to the OpenPortableDocumentFile procedure.
The best error handling strategy is to avoid raising run-time errors in the first place.