Discussion:
|
Since there is no way to use a macro to turn on macros, a technique to ensure the user has enabled macros is desirable. This particular method hides all sheets except a "welcome" sheet which tells the user to enable macros, and is enforced every time the workbook is saved. If the user opens the workbook with macros enabled, the sheets will all be unhidden by the macro. The hiding of sheets is also done using Excel VeryHidden property, which means that the sheets cannot be unhidden using Excel's menus. Keep in mind, however, that this only affects this workbook, so a user could use a macro from another workbook to unhide all of your sheets. Chances are, however, if your user is that skilled, they can always get into your file anyway. NOTE: To prevent some event looping issues, this code requires overruling Excel's built in Save events, and also requires replicating Excel's "Workbook has changed, do you want to save" prompts and actions. This code takes care of all of it. It does, however, create a very minor issue when closing the file. If the user trys to quit the application, it will close the workbook, but not Excel. Quitting again will close Excel completely.
|
Option Explicit
Const WelcomePage = "Macros"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EnableEvents = False
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 CustomSave
Case Is = vbNo
Case Is = vbCancel
Cancel = True
End Select
End If
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)
Application.EnableEvents = False
Call CustomSave(SaveAsUI)
Cancel = True
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_Open()
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
Application.ScreenUpdating = False
Set aWs = ActiveSheet
Call HideAllSheets
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
Call ShowAllSheets
aWs.Activate
Application.ScreenUpdating = True
End Sub
Private Sub HideAllSheets()
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()
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
|