Option Explicit
Private bolClosing As Boolean
Private bolInProcess As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lResponse As Long
Application.DisplayAlerts = False
'// bolClosing will be false by default, so we will initially pass this test. //
If Not bolClosing Then
'// IF the workbook is saved, it will close without further ado. ELSE, we will //
'// see what the user wants to do and control the results. //
If Not ThisWorkbook.Saved Then
lResponse = MsgBox("Do you want to save the changes you made to '" & _
Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & "'?", _
vbExclamation Or vbYesNoCancel Or vbDefaultButton1, _
"My Custom Project")
Select Case lResponse
Case vbYes
'// bolClosing is used in BeforeSave //
bolClosing = True
'// See function. We don't need to execute the save here, and in //
'// fact, due to a weird glitch in Excel (least 2000), this is //
'// better. //
Call Workbook_BeforeSave(False, False)
'//This is required, as even though the file saved while in //
'// BeforeSave, changes occurred post save. //
ThisWorkbook.Saved = True
Case vbNo
bolClosing = True
'// User doesn't want to save changes, so just mark file saved. //
ThisWorkbook.Saved = True
Case vbCancel
'// User cancelled closing, and least in Excel 2000, I found it //
'// necessary to reactivate stuff if I wanted the focus returned. //
ThisWorkbook.Activate
bolClosing = False
Cancel = True
Application.DisplayAlerts = True
ActiveCell.Activate
Exit Sub
End Select
End If
End If
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lCalculationSetting As Long
Dim wksWorksheet As Worksheet
Dim wksLastActive As Worksheet
Dim strSaveAs_Filename As String
If Not (bolInProcess And Not Cancel) Then
'// Set bolProcess to True, which will later prevent a recurse to this IF. //
bolInProcess = True
'// Let's see what the user's choices were, as to a few settings that we wish //
'// to temporarily control. //
lCalculationSetting = Application.Calculation
'// We'll stop screen updates and uneccessary calculations, which will give a //
'// better appearance and increase run speed. //
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DoEvents
'// Find the ActiveSheet, so we can redisplay it later. //
Set wksLastActive = ThisWorkbook.ActiveSheet
'// Display the prompt (the warning) sheet BEFORE hidng remaining sheets. //
shtForceEnable.Visible = xlSheetVisible
For Each wksWorksheet In ThisWorkbook.Worksheets
If Not wksWorksheet.CodeName = "shtForceEnable" Then
wksWorksheet.Visible = xlSheetVeryHidden
End If
Next
'// Set Cancel to True! If the user executed a "normal" save (clicking Save //
'// button or Ctrl+s...), then only the user's called Save is cancelled. A //
'// couple of lines down, we'll execute a Save that will not be cancelled. //
'// //
'// If on the other hand, BeforeSave is called programatically, the Cancel does //
'// nothing, and the .Save (or SaveAs) executes under our control. //
'// I would also note that excluding the Cancel results in Saving the file //
'// twice. //
Cancel = True
DoEvents
'// Now, Save workbook. If you step-thru this, you'll see that it immedietely //
'// recurses to Workbook_BeforeSave, but as bolInProcess is currently True, //
'// there is no true recurse. Thus - the statements below the .Save execute, //
'// and the user sheets are redisplayed. //
If SaveAsUI Then
ChDir ThisWorkbook.Path
strSaveAs_Filename = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.FullName, _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Are you sure you want to SaveAs?" _
)
'// Check to see if user cancelled; in which case reset bolInProcess and //
'// allow sheets to be redisplayed. Nothing is saved, so no harm, no foul. //
If strSaveAs_Filename = "False" Then
bolInProcess = False
Else
'// If user chose a filename and committed to the saveas, I strip the //
'// proposed name from the proposed fullname, so that we can saveas to //
'// the same folder we opened this workbook in. //
strSaveAs_Filename = "\" & Right(strSaveAs_Filename, Len(strSaveAs_Filename) - InStrRev(strSaveAs_Filename, "\", -1, vbTextCompare))
'// One last check. If user selects same name as current, then cancels //
'// the app alert msg (are your sure? there's already a workbook with //
'// this name...), an error ensues. //
On Error Resume Next
ThisWorkbook.SaveAs ThisWorkbook.Path & strSaveAs_Filename
Err.Clear
On Error GoTo 0
End If
Else
ThisWorkbook.Save
End If
'// IF we were closing the workbook when we decided to save, we'll leave //
'// everything hidden, reset settings, turn screen updating back on, //
'// and let the workbook close. //
If bolClosing = True Then
Application.Calculation = lCalculationSetting
Application.ScreenUpdating = True
Exit Sub
End If
'// Redisplay whichever sheets you want the user to be able to see. //
For Each wksWorksheet In ThisWorkbook.Worksheets
wksWorksheet.Visible = xlSheetVisible
Next
'// THEN hide Prompt sheet AFTER redisplaying desired Worksheets. //
shtForceEnable.Visible = xlSheetVeryHidden
If Not ActiveSheet.Name = wksLastActive.Name Then
On Error Resume Next
wksLastActive.Select
On Error GoTo 0
End If
'// You can also scroll to the last sheet you had active before the save. //
'// This does not effect which sheet is actually selected; it just puts which //
'// tabs you want in view. //
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Application.Calculation = lCalculationSetting
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
'// Reset bolInProcess for the next time that user saves file. //
bolInProcess = False
End If
End Sub
Private Sub Workbook_Open()
Dim wksWorksheet As Worksheet
'// Redisplay whichever sheets you want the user to be able to see. //
For Each wksWorksheet In ThisWorkbook.Worksheets
wksWorksheet.Visible = xlSheetVisible
Next
'// Then hide Prompt sheet AFTER redisplaying desired Worksheets. //
shtForceEnable.Visible = xlSheetVeryHidden
'// Mark workbook as saved, in case the user decides to close w/o making any //
'// changes. This way, if the user opens and closes the workbook w/o making any //
'// changes, he isn't uneccessarily asked about saving changes. //
ThisWorkbook.Saved = True
End Sub
