I have a series of macros that automates much of a process. I would like to distribute this to my coworkers via Excel Add-In and I have one piece of code I just can't seem to get right.
Here is the "master" code (which works fine):
Option Explicit
Sub MIUL_Run_All()
Dim StartTime As Double
Dim SecondsElapsed As String
'Remember time when macro starts
StartTime = Timer
Call OptimizeCode_Begin
Call Save_As
Call Format_MIUL
Call Custom_Sort_MIUL
Call Insert_Process_List
Call Format_Process_List
Call OptimizeCode_End
'Determine how many seconds code took to run
SecondsElapsed = Format((Timer - StartTime) / 86400, "ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds",
vbInformation
End Sub
The code that is giving me trouble is "Save_As". First thing I want the user to do is to save the file as a macro enabled file. Ideally, I want the code to do these things for the user:
Force the user to save as .xlsm
Provide the current file name in the Save As dialog box so they have a file name to already work with.
If the CANCEL button is pressed it must stop the entire macro!
I thought this would be a fairly trivial thing, but so far it has been the toughest part of my code.
Here is what I have tried for the Save_As code:
Application.Dialogs(xlDialogSaveAs).Show , xlOpenXMLWorkbookMacroEnabled
This code is very simple, but it doesn't address the cancel button.
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(52)
On Error GoTo 0
If userResponse = False Then
Exit Sub
Else
End If
Again for some reason this doesn't address the cancel button.
I have tried probably a half a dozen different things, most of which are similar to the above codes.
Any help is appreciated.
You have this:
If FileDialog.Show = False Then
Exit Sub
End If
Which does not account for an error, simply recognizing a state. You will want the Exit Sub to happen if there's an error only.
This error handling could be implemented by replacing :
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(52)
On Error GoTo 0
If userResponse = False Then
Exit Sub
Else
End If
With:
On Error GoTo Cat
userResponse = Application.Dialogs(xlDialogSaveAs).Show(52)
Cat:
Exit Sub
Related
I am creating a Word template that performs a bunch of actions when Document_New is initialised. For example, I am pulling in and applying Custom Document Properties from an XML file in one sub, and referring to them in a second.
I'm trying to add some error handling to close the document with an error message and prevent the rest of the VBA from running, and I can get to the point where the document closes, but the rest of the VBA code continues to execute. Ideally I need to close just this new document (other Word documents may be open on a device) and stop any more processing of VBA.
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
When this is in place, the template seems to close, but the newly created document still exists and the template VBA continues to run.
Is anyone able to suggest a way to close the template and abort the creation of the new document?
EDIT: Including an example of how I'm looking for errors.
In Document_New - I call ValidateProperties that loops through an arrayProps array that stores properties required for the template. Each property in the array is checked using the function CustomDocumentPropertyExists and if that returns false I call the sub ExitFailedValidation. This is the sub I want to call if the template fails a validation test. I want to be able to cleanly close the new document without saving and leave any other Word windows open.
Sub ValidateProperties()
Dim arrayProps(1) As String
Dim i As Long
arrayProps(0) = "prop-doc-blueprint"
arrayProps(1) = "prop-doc-stationery"
For i = 0 To UBound(arrayProps)
If CustomDocumentPropertyExists(arrayProps(i)) = False Then
ExitFailedValidation ("The required custom document property " & arrayProps(i) & " is missing. Please check " & _
"the config.xml file to ensure it is included.")
End If
Next i
End Sub
Sub ExitFailedValidation(Message As String)
MsgBox "The Template failed to load and validate." & vbCrLf & vbCrLf & _
Message, vbCritical, "Error loading template"
MsgBox ThisDocument.Name
MsgBox ActiveDocument.Name
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
The Document_New() is the entrance point in code, so it should handle the tasks that need to be run and take appropriate action should an error occurs or something did not go as expected as in your case.
In order to be able to do that, the tasks it calls must report their status, e.g. completed, failed, something is missing etc.
Therefore, change the ValidateProperties() sub into a function that returns true or false and pass a string to it as an output parameter that will hold the error message if the function fails. If all goes well, it will simply be unused.
The main point of the app. This method decides what happens in the app.
Private Sub Document_New()
Dim errorMessage As String
If Not TryValidateProperties(errorMessage) Then
ExitFailedValidation errorMessage
Exit Sub
End If
'all good - continue
End Sub
The ValidateProperties() sub changed to a method that returns true or false with an optional error message if something is wrong. Since false is the default value of a boolean, exiting the function if a property doesn't exist will return false - no need to set it explicitly.
Private Function TryValidateProperties(ByRef outMessage As String) As Boolean
'...
For i = 0 To UBound(arrayProps)
If Not CustomDocumentPropertyExists(arrayProps(i)) Then
outMessage = "The required custom document property " & arrayProps(i) & " is missing. Please check " & _
"the config.xml file to ensure it is included."
Exit Function
End If
Next i
'all good
TryValidateProperties = True
End Function
Lastly, the helper method for communicating the error. In my opinion, the document shouldn't be closed here, but within the Document_New() method if property validation fails, but I'll leave this with you.
Private Sub ExitFailedValidation(Message As String)
MsgBox Message
End Sub
To add error handling in a method:
Sub T()
On Error GoTo Trap
'main method body
Leave:
'Release any references here, e.g. close db connection, release file handle etc.
Exit Sub
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
EDIT: I figured it out myself. I feel pretty silly, but replacing "Exit Sub" with "End" works perfectly.
Background: I have a Sub that uses the "Call" function to run multiple subs within one Sub (see Code #1 below).
Option Explicit
Sub MIUL_Run_All()
Dim StartTime As Double
Dim SecondsElapsed As String
'Remember time when macro starts
StartTime = Timer
Call OptimizeCode_Begin
Call Format_MIUL
Call Custom_Sort_MIUL
Call Insert_Process_List
Call Format_Process_List
Call OptimizeCode_End
'Determine how many seconds code took to run
SecondsElapsed = Format((Timer - StartTime) / 86400, "ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
My first code that is called out, "Format_MIUL", prompts the user to save the file, using the following line of code (see Code #2 below). This code works, but the problem is that if the user presses the "Cancel" button, the rest of the code called out in the main sub (Code #1 above) will continue to run. I want ALL code to stop if the user presses the cancel button. I just can't seem to figure out how to do that.
'Save file as .xlsm
MsgBox " Save as Excel Workbook (.xlsx)!"
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(, 51)
On Error GoTo 0
If userResponse = False Then
Exit Sub
Else
End If
Any help is greatly appreciated.
The Call keyword has been obsolete for 20 years, you can remove it.
The End keyword will effectively end execution, but it's pretty much a big red "self-destruct" button that you effectively never need to use, given properly structured code.
Looks like Format_MIUL is a Sub procedure. Make it a Function and return a Boolean value that tells the caller whether it's ok to proceed, or if the rest of the operations should be cancelled:
Private Function Format_MUIL() As Boolean
'...
'Save file as .xlsm
MsgBox " Save as Excel Workbook (.xlsx)!"
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(, 51)
On Error GoTo 0
'return False if userResponse isn't a filename, True otherwise:
Format_MUIL = Not VarType(userResponse) = vbBoolean
End Function
And now instead of this:
Call Format_MIUL
The caller can do this:
If Not Format_MIUL Then Exit Sub
And there you go, graceful exit without any self-destruct buttons pressed.
This is the VBA code I am learning to write (got some reference from the Internet)
Public whatyousay As String
Sub testing()
b14
b15
End Sub
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function
Sub b14()
Dim sh As Worksheet
Do Until WorksheetExists(whatyousay)
whatyousay = InputBox("Enter sheet name")
If Not WorksheetExists(whatyousay) Then MsgBox whatyousay & " doesn't exist.", vbExclamation
Loop
If WorksheetExists(whatyousay) Then Sheets(whatyousay).Activate
End Sub
Sub b15()
ThisWorkbook.Worksheets(whatyousay).Range("A1").Value = xxxx
End Sub
I must have wrongly adjust the code, as I can't find anyone having the same problem on the Internet.
When the button is clicked, it is supposed to prompt user input for the sheet name, then perform some actions.
Now, the problem I am facing is that the button only prompt user input for one time. If it was clicked the second time, it will used the previous user input without prompting.
Can anyone of you please point me to the right direction?
You are not erasing what was left in whatyousay during the last loop.
Sub b15()
ThisWorkbook.Worksheets(whatyousay).Range("A1").Value = xxxx
whatyousay = vbnullstring '<~~ remove the string from last time
End Sub
Personally, I avoid public vars. You can do the same thing by passing the string var into the secondary sub as a parameter.
I'm a novice self-taught VBA programmer knowing just enough augment Excel/Access files here and there. I have a mysterious 438 error that only popped up when a coworker made a copy of my workbook (Excel 2013 .xlsm) and e-mailed it to someone.
When the file is opened, I get a run time 438 error when setting a variable in a module to a ActiveX combobox on a sheet. If I hit end and rerun the Sub, it works without issue.
Module1:
Option Private Module
Option Explicit
Public EventsDisabled As Boolean
Public ListBox1Index As Integer
Public cMyListBox As MSForms.ListBox
Public cMyComboBox As MSForms.Combobox
Public WB As String
Sub InitVariables()
Stop '//for breaking the code on Excel open.
WB = ActiveWorkbook.Name
Set cMyListBox = Workbooks(WB).Worksheets("Equipment").Listbox1
Set cMyComboBox = Workbooks(WB).Worksheets("Equipment").Combobox1 '//438 here
End Sub
Sub PopulateListBox() '//Fills list box with data from data sheet + 1 blank
Dim y As Integer
If WB = "" Then InitVariables
ListBox1Index = cMyListBox.ListBoxIndex
With Workbooks(WB).Worksheets("Equipment-Data")
y = 3
Do While .Cells(y, 1).Value <> ""
y = y + 1
Loop
End With
Call DisableEvents
cMyListBox.ListFillRange = "'Equipment-Data'!A3:A" & y
cMyListBox.ListIndex = ListBox1Index
cMyListBox.Height = 549.75
Call EnableEvents
End Sub
...
PopulateListBox is called in the Worksheet_activate sub of the "Equipment" sheet.
All my code was in the "Equipment" sheet until I read that was bad form and moved it to Module1. That broke all my listbox and combobox code but based on the answer in this post I created the InitVariables Sub and got it working.
I initially called InitVariables once from Workbook_open but added the If WB="" check after WB lost its value once clicking around different workbooks that were open at the same time. I'm sure this stems from improper use of Private/Public/Global variables (I've tried understanding this with limited success) but I don't think this is related to the 438 error.
On startup (opening Excel file from Windows Explorer with no instances of Excel running), if I add a watch to cMyComboBox after the code breaks at "Stop" and then step through (F8), it sets cMyComboBox properly without error. Context of the watch does not seem to affect whether or not it prevents the error. If I just start stepping or comment out the Stop line then I get the 438 when it goes to set cMyComboBox.
If I add "On Error Resume Next" to the InitVariables then I don't error and the project "works" because InitVariables ends up getting called again before the cMyComboBox variable is needed and the sub always seems to work fine the second time. I'd rather avoid yet-another-hack in my code if I can.
Matt
Instead of On Error Resume Next, implement an actual handler - here this would be a "retry loop"; we prevent an infinite loop by capping the number of attempts:
Sub InitVariables()
Dim attempts As Long
On Error GoTo ErrHandler
DoEvents ' give Excel a shot at finishing whatever it's doing
Set cMyListBox = ActiveWorkbook.Worksheets("Equipment").Listbox1
Set cMyComboBox = ActiveWorkbook.Worksheets("Equipment").Combobox1
On Error GoTo 0
Exit Sub
ErrHandler:
If Err.Number = 438 And attempts < 10 Then
DoEvents
attempts = attempts + 1
Resume 'try the assignment again
Else
Err.Raise Err.Number 'otherwise rethrow the error
End If
End Sub
Resume resumes execution on the exact same instruction that caused the error.
Notice the DoEvents calls; this makes Excel resume doing whatever it was doing, e.g. loading ActiveX controls; it's possible the DoEvents alone fixes the problem and that the whole retry loop becomes moot, too... but better safe than sorry.
That said, I'd seriously consider another design that doesn't rely so heavily on what appears to be global variables and state.
I come again with new query, I have made the Macro and assigned it on Workbook.open, now I want little bit changed, I want to prompt message BOX which have contains Do You want to Stop Macro ? Option YES and NO, If I clicked on Yes with in 10 seconds of workbook Open, I want to stay on same excel without executing the Macro; otherwise, run the macro if I clicked NO or if 10 seconds is completed.
VBA has a MsgBox function, but you cannot let that one time out like you want.
To get a prompt with time-out functionality, you could use the Popup method of the WScript.Shell object. You can create the Shell object with a CreateObject call, and see the MSDN documentation for the Popup method for more details on how to use it.
#Dharmendra Maybe you can try this code:
Private Sub Workbook_Open()
wbClose
End Sub
Sub wbClose()
Dim time As Integer, prompt As String
time = 10 'this is in seconds format
prompt = "This Workbook will close in " & time & " seconds." & _
vbLf & "Press OK if you want some changes to this Workbook."
With CreateObject("WScript.Shell")
Select Case .Popup(prompt, time, "Message", 0)
Case 1
Exit Sub
End Select
End With
ThisWorkbook.Close True
End Sub
Just do some revisions if you like. Thanks!