Force Users to Enable Macros in a Workbook
The following code forces a user to enable macros in a workbook. If a user opens the workbook and disables macros, only a warning sheet is displayed and all other sheets are hidden. They cannot be unhidden using Excel's menus. The warning sheet asks the user to re-open the workbook and enable macros. Once macros are enabled, the warning sheet is hidden and all other sheets are displayed.
After you've added the code to your workbook, you'll need to create a new worksheet and you'll need to name the worksheet "Warning". Then you'll need to add a message on the worksheet asking the user to re-open the workbook and enable macros. Lastly, you'll need to save your workbook.
Note that this code uses a custom save routine, which avoids the dialog box for the Compatibility Checker. Therefore, if you're saving an Excel 2007-2010 workbook as an Excel 97-2003 workbook, make sure that there are no compatibility issues or that only minor ones exist.
'Force the explicit
declaration of variables
Option Explicit
'Assign the name of
the warning sheet to a constant
Const
Warning As
String =
"Warning"
Private Sub
Workbook_Open()
'Turn off screen updating
Application.ScreenUpdating = False
'Call the ShowAllSheets
routine
Call
ShowAllSheets
'Set the workbook's Saved
property to True
Me.Saved = True
'Turn on screen updating
Application.ScreenUpdating = True
End Sub
Private Sub
Workbook_BeforeClose(Cancel As
Boolean)
'Declare the variable
Dim Ans As Integer
'If the workbook's Saved
property is False, emulate Excel's default save prompt
If Me.Saved = False Then
Do
Ans
= MsgBox("Do you want to save the changes you made to '" & _
Me.Name
& "'?", vbQuestion + vbYesNoCancel)
Select Case Ans
Case vbYes
Call CustomSave
Case vbNo
Me.Saved
= True
Case vbCancel
Cancel
= True
Exit Sub
End Select
Loop Until Me.Saved
End If
End Sub
Private Sub
Workbook_BeforeSave(ByVal
SaveAsUI As
Boolean,
Cancel As Boolean)
'Cancel regular saving
Cancel = True
'Call the CustomSave routine
Call
CustomSave(SaveAsUI)
End Sub
Private Sub CustomSave(Optional SaveAs As Boolean)
'Declare the variables
Dim ActiveSht As Object
Dim FileFormat As Variant
Dim FileName As String
Dim FileFilter As String
Dim FilterIndex As Integer
Dim Msg As String
Dim Ans As Integer
Dim OrigSaved As
Boolean
Dim
WorkbookSaved As Boolean
'Turn off screen updating
Application.ScreenUpdating = False
'Turn off events so that the
BeforeSave event doesn't occur
Application.EnableEvents = False
'Assign the status of the
workbook's Saved property to a variable
OrigSaved = Me.Saved
'Assign the active sheet to
an object variable
Set ActiveSht =
ActiveSheet
'Call the HideAllSheets
routine
Call
HideAllSheets
'Save workbook or prompt for
SaveAs filename
If SaveAs Or Len(Me.Path)
= 0 Then
If
Val(Application.Version) < 12 Then
FileFilter
= "Microsoft Office Excel Workbook (*.xls), *.xls"
FilterIndex
= 1
Else
FileFilter
= "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm, " & _
"Excel
97-2003 Workbook (*.xls), *.xls"
If
Right(Me.Name, 4) = ".xls" Then
FilterIndex
= 2
Else
FilterIndex
= 1
End If
End If
Do
FileName
= Application.GetSaveAsFilename( _
InitialFileName:=Me.Name,
_
FileFilter:=FileFilter,
_
FilterIndex:=FilterIndex,
_
Title:="SaveAs")
If FileName =
"False" Then
Exit Do
If
IsLegalFilename(FileName) = False
Then
Msg
= "The file name is invalid. Try one of the "
Msg
= Msg & "following:" & vbCrLf & vbCrLf
Msg
= Msg & Chr(149) & " Make sure that the file name "
Msg
= Msg & "does not contain any" & vbCrLf
Msg
= Msg & " of the following
characters: "
Msg
= Msg & "< > ? [ ] : | or *" & vbCrLf
Msg
= Msg & Chr(149) & " Make sure that the file/path "
Msg
= Msg & "name does not exceed" & vbCrLf
Msg
= Msg & " more than 218 characters."
MsgBox
Msg, vbExclamation, "Invalid
File Name"
Else
If
Val(Application.Version) < 12 Then
FileFormat
= -4143
Else
If
Right(FileName, 4) = ".xls" Then
FileFormat
= 56
Else
FileFormat
= 52
End If
End If
If
Len(Dir(FileName)) = 0 Then
Application.DisplayAlerts
= False
Me.SaveAs FileName,
FileFormat
Application.DisplayAlerts
= True
WorkbookSaved
= True
Else
Ans
= MsgBox("'" & FileName & "' already
exists. " &
_
"Do
you want to replace it?", vbQuestion + vbYesNo, _
"Confirm
Save As")
If Ans = vbYes Then
Application.DisplayAlerts
= False
Me.SaveAs FileName,
FileFormat
Application.DisplayAlerts
= True
WorkbookSaved
= True
End If
End If
End If
Loop Until Me.Saved
Else
Application.DisplayAlerts
= False
Me.Save
Application.DisplayAlerts
= True
WorkbookSaved
= True
End If
'Call the ShowAllSheets
routine
Call
ShowAllSheets
'Activate the prior active
sheet
ActiveSht.Activate
'Set the workbook's Saved
property
If WorkbookSaved
Then
Me.Saved
= True
Else
Me.Saved
= OrigSaved
End If
'Turn on screen updating
Application.ScreenUpdating = True
'Turn on events
Application.EnableEvents = True
End Sub
Private Sub
HideAllSheets()
'Declare the variable
Dim Sh As Object
'Display the warning sheet
Sheets(Warning).Visible =
xlSheetVisible
'Hide every sheet, except the
warning sheet
For Each Sh In Sheets
If Sh.Name
<> Warning Then
Sh.Visible
= xlSheetVeryHidden
End If
Next Sh
End Sub
Private Sub
ShowAllSheets()
'Declare the variable
Dim Sh As Object
'Display every sheet, except
the warning sheet
For Each Sh In Sheets
If Sh.Name
<> Warning Then
Sh.Visible
= xlSheetVisible
End If
Next Sh
'Hide the warning sheet
Sheets(Warning).Visible =
xlSheetVeryHidden
End Sub
Private Function
IsLegalFilename(ByVal
fname As
String) As Boolean
Dim BadChars As Variant
Dim i As Long
If Len(fname)
> 218 Then
IsLegalFilename
= False
Exit Function
Else
BadChars
= Array("\", "/", "<", ">", "?", "[", "]", ":", "|", "*",
"""")
fname
= GetFileName(fname)
For i = LBound(BadChars)
To UBound(BadChars)
If InStr(1,
fname, BadChars(i)) > 0 Then
IsLegalFilename
= False
Exit Function
End If
Next i
End If
IsLegalFilename = True
End Function
Private Function
GetFileName(ByVal
FullName As String)
As String
Dim i As Long
For i =
Len(FullName) To
1 Step
-1
If Mid(FullName,
i, 1) = Application.PathSeparator Then Exit For
Next i
GetFileName = Mid(FullName, i +
1)
End Function
Where to Put the Code
- Open the workbook in which to store the code.
- Open the Visual Basic Editor (Alt+F11).
- In the Project Explorer window (Ctrl+R), right-click ThisWorkbook, and select "View Code".
- Copy/paste the above code into the code module for ThisWorkbook.
- Return to Microsoft Excel (Alt+Q).
- Save the workbook.
Sample Workbook: Download