I wrote a code which assigns to a button. When the button is pushed, it creates a new workbook and asks the user where to save the new file.
I want to make sure that if the user clicks cancel then it closes the new workbook and exits the sub.
I have wrote it as below but I don't know how to write a better code. I know that the if can be improved.
Option Explicit
Sub Create_a_new_workbook_and_save_it()
Dim xlPath As String
Workbooks.Add
Application.DisplayAlerts = False
xlPath = Application.GetSaveAsFilename(Title:="Select where you want to save your file") & "xlsm"
If xlPath = "Falsexlsm" Then
ActiveWorkbook.Close
Exit Sub
End If
ActiveWorkbook.SaveAs _
Filename:=xlPath, FileFormat:=52
Application.DisplayAlerts = True
End Sub
The above code working fine as you want....
Related
I'm going to try to summarize it. (Excel 2013)
I have created a Form+VBA project that does the following when you open the File: I check to see if it is the only workbook and if it is not then I remind the user to use a shortcut that I created that opens the file on its own instance. If it is on its own instance, It launches a Form, it makes the form unmovable, it also cancels the X button. Pretty much an "always on top of this instance of excel" form.
Private WithEvents App As Application
Private Sub Workbook_Open()
Set Wb = ThisWorkbook
If Application.Workbooks.Count > 1 Then
MsgBox "Please use the shortcut to open this file"
Application.DisplayAlerts = False
Wb.Close False
Else
Set App = Application
UserForm1.Show
End If
End Sub
I added triggers/event that when you open a New Workbook or an Existing workbook on the same instance it closes them and it opens them on a separate instance. Again this is because the form is "always on top".
Private Sub App_NewWorkbook(ByVal Wb As Workbook)
Set cwb = ThisWorkbook
If Wb.Name <> cwb.Name Then
Dim exDir As String, opFile As Variant
Application.DisplayAlerts = False
Wb.Close False
exDir = "C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE"
opFile = Shell("""" & exDir & """ /X", vbNormalFocus)
Application.DisplayAlerts = True
End If
End Sub
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Set cwb = ThisWorkbook
If Wb.Name <> cwb.Name Then
Dim fDir, exDir As String, opFile As Variant
fDir = Wb.Path & "\" & Wb.Name
Application.DisplayAlerts = False
Wb.Close False
exDir = "C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE"
opFile = Shell("""" & exDir & """ /X """ & fDir & """", vbNormalFocus)
Application.DisplayAlerts = True
End If
End Sub
It works fine, up to a point.
Here is the issue: When the UserForm is closed, both triggers/events work fine for when you open a New Workbook or an Existing File, when the UserForm is active only the trigger for the New Workbook works. If I try to open another excel file it tries to open the file on the existing instance.
Well after fighting with it for more time I figured out the problem. When the form is active and you want to open an existing file, excel doesn't let the new file Open at all, therefore it never triggers the WorkbookOpen event, because the form is open. The NewWorkbook event works fine because is triggered when excel tries to open a NewWorkbook.
The way I got this to be fixed is by Allowing interaction between the Form and Excel using the vbModeless property on the UserForm1.Show command. This allows the excel window to be used while having the UserForm opened. Since I am making the form unmovable, non closable and I also resize excel to the same size as the form, this works for me. Now all evens trigger because the main Excel window can do everything, and therefore it triggers the WorkbookOpen events as well.
I have three files, one is app.xlsm, the other one is lib.xlsm, whereas app.xlsm uses lib.xlsm as a reference (which is specified in Tools -> References). The third, third.xlsm has the following code:
Private Sub Workbook_Open()
prompt = MsgBox("If you click Ok, Excel will force close." & vbCrLf & _
"If you click Cancel, you can work with the file", vbOKCancel)
If prompt = vbOK Then
Application.DisplayAlerts = False
thisworkbook.Close True
Application.Quit
End If
End Sub
Assume that I have app and lib open. Now when I open third, and then click OK at the prompt, app gets closed but lib remains open. I.e. Excel does not get force shut.
I need Excel to close all files without saving them and close silently.
Many thanks.
What happens if you loop through the open workbooks in this instance, ie
Private Sub Workbook_Open()
Dim wb As Workbook
prompt = MsgBox("If you click Ok, Excel will force close." & vbCrLf & _
"If you click Cancel, you can work with the file", vbOKCancel)
If prompt = vbOK Then
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then wb.Close False
Next
End If
ThisWorkbook.Saved = True
Application.Quit
End Sub
thermonuclear option to close all Excel instances
Private Sub Workbook_Open()
Dim wb As Workbook
prompt = MsgBox("If you click Ok, Excel will force close." & vbCrLf & _
"If you click Cancel, you can work with the file", vbOKCancel)
If prompt = vbOK Then
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then wb.Close False
Next
End If
X2 = Shell("powershell.exe kill -processname excel", 1)
End Sub
As topic implies I have a problem I cannot find any solution to.
I have a Workbook (1) with the purpose to open other WBs and run macros in them.
Everything works like a charm except when the other WB has Workbook_Open() event to open a Userform (typically it asks if the WB should be updated). Then I get error code 1004 and my code fails.
How could I supress the Workbook_Open event from triggering when I open another WB?
I have tried the setting Application.EnableEvents = False but it´s not related.
Thank you very much for any help on this topic!
Here is the code for opening the WB
Public Function wbTargetOpen(sTargetPath As String, SPassword As String) As Workbook
Dim sWBName As String
sWBName = Mid(sTargetPath, InStrRev(sTargetPath, "\") + 1, Len(sTargetPath) - InStrRev(sTargetPath, "\") + 1)
If WorkbookIsOpen(sWBName) Then
Set wbTargetOpen = Workbooks(sWBName)
If wbTargetOpen.ReadOnly = True Then
wbTargetOpen.Close
Set wbTargetOpen = Workbooks.Open(FileName:=sTargetPath, UpdateLinks:=0, ReadOnly:=False, WriteResPassword:=SPassword)
End If
Else
Set wbTargetOpen = Workbooks.Open(FileName:=sTargetPath, UpdateLinks:=0, ReadOnly:=False, WriteResPassword:=SPassword)
End If
If wbTargetOpen.ReadOnly Then sErrorCode = "ReadOnly"
End Function
All you have to do is add one word VbModeless to the other workbook which launches the userform.
Private Sub Workbook_Open()
UserForm1.Show vbModeless
End Sub
The vbModeless will launch the form but will also allow your macro to run.
Close the other userforms before you run the macros.
Sub CloseOtherUserForms()
Dim frm As UserForm
For Each frm In UserForms
If Not TypeName(frm) = "MacroForm" Then
Unload frm
End If
Next
End Sub
I have used this site quite a bit but this is the first question i have posted, hopefully I can give enough detail. I cannot find any relevant answers because no matter what i search, I get various answers relating to looping code.
Some background:
I have designed an excel document to track some items in my workplace (hereafter referred to as Master Document). As the previous tracker allowed users to edit anything at any time, I have used forms to ensure all information is entered correctly and stored securely. For each item in the Master Document there is a separate excel workbook (hereafter referred to as Item Document).
There are a number of sheets in the Master Document which run code everytime they are activated (because they need to update).
As there is some VBA code in every Item Document which is crucial in syncing data with the Master Document, I have added a Warning worksheet which is shown when the Item Document is opened without macros. This involved using the workbook open, before save and after save events to ensure only the Warning is shown without macros. Here is the code for each event (placed in ThisWorkbook Module obviously)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Auto_Open
'This is for sync (Master Document checks for text file to see if any changes have been made to Item Document)
If booChange = True Then
Dim oFile As Object
Set oFile = fso.CreateTextFile(strTextFile)
SetAttr strTextFile, vbHidden
booChange = False
End If
'Turn off Screen Updating
Application.ScreenUpdating = False
'Show warning sheet
Sheets("Warning").Visible = xlSheetVisible
'Hide all sheets but Warning sheet
For Each sh In ThisWorkbook.Worksheets
If Not sh.Name = "Warning" Then sh.Visible = xlVeryHidden
Next sh
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Show all sheets
For Each sh In ThisWorkbook.Worksheets
sh.Visible = xlSheetVisible
Next sh
'Hide the warning sheet
Sheets("Warning").Visible = xlVeryHidden
'Return focus to the main page
ThisWorkbook.Worksheets(1).Activate
'Turn on Screen Updating
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_Open()
'Turn off Screen Updating
Application.ScreenUpdating = False
'Show all sheets
For Each sh In ThisWorkbook.Worksheets
sh.Visible = xlSheetVisible
Next sh
'Hide the warning sheet
Sheets("Warning").Visible = xlVeryHidden
'Return focus to the main page
ThisWorkbook.Worksheets(1).Activate
'Turn on Screen Updating
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
End Sub
And just for completeness, here is all code in Module1 of Item Document
'Declarations
'Strings
Public strSourceFolder As String
Public strTextFile As String
'Other
Public fso As FileSystemObject
Public booChange As Boolean
Public wsFlow As Worksheet
'Constants
Public Const strURNSheetName = "Part 1 Plant Flow Out Summ"
Sub Auto_Open()
Set fso = CreateObject("Scripting.FileSystemObject")
Set wsFlow = ThisWorkbook.Worksheets(strURNSheetName)
strSourceFolder = fso.Getfile(ThisWorkbook.FullName).ParentFolder.Path
strTextFile = fso.BuildPath(strSourceFolder, ThisWorkbook.Worksheets(strURNSheetName).Range("W2").Value & ".txt")
End Sub
When an item is created in the Master Document using the 'frmNewEntry' form the info is checked and entered into the Master Document then a template Item Document is opened and saved with a new unique filename. It is then unprotected, updated with the new information, protected, saved and closed. The Master Document is then saved. Code follows (edited to omit lengthy formatting and data entry):
Form Code:
Private Sub btnSave_Click()
'Values on form are verified
'Master Document sheet is unprotected, formatted and data entry occurs
'Clear Userform and close
For Each C In frmNewEntry.Controls
If TypeOf C Is MSForms.ComboBox Then
C.ListIndex = -1
ElseIf TypeOf C Is MSForms.TextBox Then
C.Text = ""
ElseIf TypeOf C Is MSForms.CheckBox Then
C.Value = False
End If
Next
frmNewEntry.Hide
'Create filepaths
Create_Filepath
'Some hyperlinks are added and the Master Document worksheet is protected again
'Create Flowout Summary
Create_Flowout_Summary
'Update Flowout Summary
Update_Flowout_Summary
'Turn on screen updating
Application.ScreenUpdating = True
'Update Activity Log
Update_Log ("New: " & strNewURN)
Debug.Print "Before Save Master"
'Save tracker
ThisWorkbook.Save
Debug.Print "After Save Master"
End Sub
Module1 Code:
Public Sub Create_Flowout_Summary()
'Create a new flowout summary from the template
'Turn off screen updating
Application.ScreenUpdating = False
'Check if workbook is already open
If Not Is_Book_Open(strTemplate) Then
Application.Workbooks.Open (strTemplatePath)
End If
Debug.Print "Before SaveAs Create"
'Save as new flowout summary
Application.Workbooks(strTemplate).SaveAs fileName:=strFilePath
Debug.Print "After SaveAs Create"
'Close Document Information Panel
ActiveWorkbook.Application.DisplayDocumentInformationPanel = False 'Doesn't seem to work
'Turn on screen updating
Application.ScreenUpdating = True
End Sub
Public Sub Update_Flowout_Summary()
'Update the flowout summary for current call
Dim wsURN As Worksheet
Set wsURN = Workbooks(strFileName).Worksheets(strWsURNName)
'Unprotect Flowout Summary worksheet
wsURN.Unprotect "Flowout Summary"
'Write values to flowout summary
'Protect Flowout Summary worksheet
wsURN.Protect "Flowout Summary", False, True, True, True, True
Debug.Print "Before Save Update"
'Save flowout summary
Application.Workbooks(strFileName).Save
Debug.Print "After Save Update"
'Close Document Information Panel
ActiveWorkbook.Application.DisplayDocumentInformationPanel = False
'Turn on screen updating
Application.ScreenUpdating = True
End Sub
Problem detail:
When I create a new entry it is taking a very long time, I accidentally discovered that the Master Document is running the code in every sheet activate event (mentioned above) (I had a diagnostic msgbox in one of the sheets which mysteriously appeared when i created a new entry)
I have therefore drawn the conclusion that the code is somehow activating every worksheet but have no idea why....
Any help will be much appreciated, and if i have missed anything out that may help in diagnosing just let me know.
EDIT: The other strange phenomenon is that this does not happen when I try to step through the code to find exactly where the activate events are being triggered.
EDIT: Code in the worksheet activate event
Private Sub Worksheet_Activate()
'Turn off Screen Updating
Application.ScreenUpdating = False
'Simply writes data to the sheet (excluded because it is lengthy)
'Turn on Screen Updating
Application.ScreenUpdating = True
wsMyCalls.Protect Password:=strPassword
Debug.Print "wsMyCalls"
MsgBox "This sheet uses your username to display any calls you own." & vbNewLine & _
"It relies on the correct CDSID being entered for owner." & vbNewLine & vbNewLine & _
"Regards" & vbNewLine & _
"Your friendly spreadsheet administrator", vbOKOnly, "Information"
End Sub
EDIT: I added some Debug.Prints to the code (above) and this is what i got.
Before SaveAs Create
After SaveAs Create
Before Save Update
After Save Update
Before Save Master
After Save Master
wsMyCalls
This shows that the code is executing between Debug.Print "After Save Master" and an End Sub. There is no code in there???
Thanks
I believe we aren't seeing your whole code on here. It is difficult to diagnose considering we don't have the workbook to debug ourselves. However I have a similar 'welcome' page that is displayed every time one of my workbooks opens to ask the user to activate macroes. I DO put EnableEvents to false and put my sheet in a certain state before saving, and placing it back after saving.
I will show you exactly how I do it because I have a feeling your problem is related to not disabling EnableEvents are the right timings. I am unsure how to time it based on how your workbook functions because of the mentioned incomplete code.
The sheet is called f_macros. Here is it's worksheet activate event that prevents further navigation:
Private Sub Worksheet_Activate()
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayWorkbookTabs = False
End Sub
In my Workbook_BeforeSave:
I record the current state of DisplayHeadings and such at first:
Dim Displaytabs As Boolean
Dim DisplayHeadings As Boolean
Dim menu As CommandBar
Dim ligne As CommandBarControl
Displaytabs = ActiveWindow.DisplayWorkbookTabs
DisplayHeadings = ActiveWindow.DisplayHeadings
I then reset my custom right click, turn off EnableEvents and screen updating. I set DisplayWorkbookTabs to false for good measure.
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.CommandBars("Cell").reset
ActiveWindow.DisplayWorkbookTabs = False
Then I run Cacherdata (HideData, sub in another module that is annexed underneath) I save, and i run the sub macro_activees to put the workbook back in working order for the user. I turn EnableEvents back on, and put the headings back to how they were:
m_protection.Cacherdata
ThisWorkbook.Save
m_protection.macro_activees
Application.ScreenUpdating = True
Application.enableevents = True
ActiveWindow.DisplayWorkbookTabs = Displaytabs
ActiveWindow.DisplayHeadings = DisplayHeadings
I cancel the ordinary Save (important!) and indicate the workbook is saved so they can exit normally without being prompted to save.
Cancel = True
ThisWorkbook.Saved = True
In the BeforeClose, it checks whether or not the workbook state is Saved. if yes, it quits. If not, it does a similar procedure:
If Not (ThisWorkbook.Saved) Then
rep = MsgBox(Prompt:="Save changes before exiting?", _
Title:="---", _
Buttons:=vbYesNoCancel)
Select Case rep
Case vbYes
Application.ScreenUpdating = False
Application.enableevents = False
ActiveWindow.DisplayHeadings = True
m_protection.Cacherdata
ThisWorkbook.Save
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
The workbook open event checks whether it is read-only mode, but that's all. I don't have a Workbook AfterSave.
Annex
CacherData makes every sheet VeryHidden so the user doesn't f*** up the data without activating macros. It records the current active sheet so the user goes back to where they were, unprotects the workbook, hides sheets, protects it back and that's all:
Sub Cacherdata()
Dim ws As Worksheet
f_param.Range("page_active") = ActiveSheet.Name
f_macros.Activate
ThisWorkbook.Unprotect "-----"
For Each ws In ThisWorkbook.Worksheets
If ws.CodeName <> "f_macros" Then ws.visible = xlSheetVeryHidden
Next
ThisWorkbook.Protect "-----"
Exit Sub
End Sub
macros_activees does the opposite:
Sub macro_activees()
Dim ws As Worksheet
ThisWorkbook.Unprotect "-----"
For Each ws In ThisWorkbook.Worksheets
ws.visible = xlSheetVisible
Next
ThisWorkbook.Sheets(f_param.Range("page_active").Value).Activate
ThisWorkbook.Unprotect "-----"
'it unportects twice because of the activate event of the worksheet, don't mind that
Exit Sub
End Sub
Error handling was removed because it was useless to show, but everything else should be there.
EDIT: If this doesn't help you at all, maybe your problem is because the workbooks you create have code in them 9from what i gather) that can affect how long it takes to run your code? If they have an Open procedure themselves, could that be it?
I have a "master" timesheet macro which users open and complete. Upon close I force a macro (in ThisWorkbook) to run and rename the master to a filename held in range save name.
This works perfectly the first time the user opens Excel, edits and closes the workbook. However, if the user opens "master" timesheet the second time, completes another timesheet and closes, without closing Excel in between, then the macro does not run.
I have searched extensively to see if there is some "global variable" that I need to reset but with no joy.
Here is the code. Any advice would be appreciated.
Private Sub Workbook_BeforeClose(SaveAsUI As Boolean)
If Not SaveAsUI Then
Cancel = True
Application.EnableEvents = False
MSG1 = MsgBox("This File will be saved as....... " & Sheets("Timesheet").Range("savename").Value & ".xlsm", vbOKOnly, "Confirm")
Me.SaveAs Filename:=ThisWorkbook.Path & "\" & Sheets("Timesheet").Range("savename").Value & ".xlsm"
ActiveWorkbook.Close False
Application.EnableEvents = True
End If
End Sub
#Bob, seems as if this has something to do with the BeforeClose event. Before closing the workbook, you're trying a SaveAs. This could cause some issues. Did you try to debug this macro? If yes, what did you found?