PDA

View Full Version : Solved: Force users to enable macros in a workbook code by Ken Puls.



Bob Blooms
10-23-2009, 12:04 PM
I have put the code into my personnel forecast model. It does what it is suppose to do. However, when x-ing out of Excel the workbook close, but Excel continues to run. What do I need to do so that Excel closes completely?

This is the code as I entered it.


Option Explicit
Const WelcomePage = "Macros"

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 = True
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
Sheets("Data").Protect Password:="xxxxx",
UserInterFaceOnly:=True
Dim Msg As String, Title As String
Dim Config As Integer, Ans As Integer
Msg = "Do you want to update the Personnel Forecast?"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & "If you choose not to perform the update "
Msg = Msg & "you can do so at anytime by "
Msg = Msg & vbNewLine & "Clicking the keys ""Shift,"" ""Ctrl"" and ""U"""
Title = "FY 2010 Personnel Forecast"
Config = vbYesNo + vbQuestion
Ans = MsgBox(Msg, Config, Title)
If Ans = vbYes Then UpdatePersonnelCostForecast

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 (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
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

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

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

GTO
10-23-2009, 08:56 PM
Greetings,

I did not look up Ken's KB entry or article at ExcelGuru.ca, but presuming you stuck close to it, I believe there's a slight glitch in BeforeClose. After turning events back on, I do not think we want to call for another .Close; rather, just let it die on course.

See if this works:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

'... other statements...

'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 = True
Application.EnableEvents = True
'// I do not think this is desirable... //
'.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub


I also noted that if you open the workbook and make no changes, it appears you should be asked if you want to save (if you go to exit w/o making any changes). This can be confusing for the user. You may wish to tack in the below.

Private Sub Workbook_Open()
Dim Msg As String, Title As String
Dim Config As Integer, Ans As Integer
'Unhide all worksheets


' ...statements...


'// Add//
ThisWorkbook.Saved = True

If Ans = vbYes Then UpdatePersonnelCostForecast

End Sub


Hope that helps,

Mark

Bob Blooms
10-25-2009, 09:52 AM
Mark, thanks, all your recommended changes work.:clap: