I'm hoping someone can help me out. I've utilized a macro which forces a user to enable macros on a worksheet and what happens is when this form is open and at least one other document is open, Excel crashes upon closing (not saving).
Luckily there's auto recover, but that's not a solution when about 10 people use this form so I've narrowed it down to opening the file within a single instance of Excel in addition to one or more other documents.
I've been able to solve this by opening Excel in another instance (another process is created by default), but this requires a registry change as I haven't successfully gotten Excel to do this through its own settings.
The macro I have is activated when someone saves, opens, and closes the document so I'm sure it lies within here, but I can't tell if there's some condition or loop that's causing Excel to overload or not.
Option Explicit
Const WelcomePage = "Macros"
Const FilterLists = "Filter Lists"
Const Formulae = "Formulae"
Const StdLists = "Std Lists"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False
'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If
'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = False
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False
'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True
'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_Open()
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
End Sub
Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False
'Record active worksheet
Set aWs = ActiveSheet
'Hide all sheets
Call HideAllSheets
'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xlsm), *.xlsm")
If Not newFname = "False" Then
Worksheets("Machine Spec").Protect DrawingObjects:=False, AllowFormattingCells:=True, Contents:=True, Scenarios:= _
True, AllowFiltering:=True
Sheets("Filter Lists").Visible = False
Sheets("Formulae").Visible = False
Sheets("Std Lists").Visible = False
Worksheets("Summary").Unprotect Password:=""
Worksheets("Summary").UsedRange.Locked = True
Worksheets("Summary").Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
ThisWorkbook.SaveAs newFname
End If
Else
ThisWorkbook.Save
Worksheets("Machine Spec").Protect DrawingObjects:=False, AllowFormattingCells:=True, Contents:=True, Scenarios:= _
True, AllowFiltering:=True
Sheets("Filter Lists").Visible = False
Sheets("Formulae").Visible = False
Sheets("Std Lists").Visible = False
Worksheets("Summary").Unprotect Password:=""
Worksheets("Summary").UsedRange.Locked = True
Worksheets("Summary").Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
End If
'Restore file to where user was
Call ShowAllSheets
aWs.Activate
'Restore screen updates
Application.ScreenUpdating = True
End Sub
Private Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet
Worksheets(WelcomePage).Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws
Sheets("Filter Lists").Visible = False
Sheets("Formulae").Visible = False
Sheets("Std Lists").Visible = False
Worksheets(WelcomePage).Activate
End Sub
Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws
Sheets("Filter Lists").Visible = False
Sheets("Formulae").Visible = False
Sheets("Std Lists").Visible = False
Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub
Thanks for any help!
Bookmarks