我改编了一些在这里找到的代码http://www.vbaexpress.com/kb/getarticle.php?kb_id=379用于强制用户启用宏的简洁解决方案。这种方法是解决这个问题的好方法。但是，我的附加要求是：一个特定的用户需要工作簿中更敏感的 2 张工作表版本。根据对 MsgBox 的回答，InputBox 需要密码验证，然后显示这些工作表的敏感版本。我相信答案在于如何保存工作簿，然后在重新打开工作簿时如何取消隐藏所有工作表（因为其中两张工作表被有效地密码锁定）但是现在当我打开这个工作簿时，用于取消隐藏的密码这两个打开工作簿需要工作表的敏感版本。所以我更改了验证上述表格所需的密码，但打开工作簿仍然需要原始密码：
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
Dim msg1, msg2, Pwd As String
Pwd = "5555"
Do
msg1 = MsgBox("Are you the Master User?", vbYesNo)
Loop Until msg1 = vbNo Or msg1 = vbYes
If msg1 = vbNo Then
Worksheets("Sensitive Sheet 1").Visible = xlVeryHidden
Worksheets("Sensitive Sheet 2").Visible = xlVeryHidden
ThisWorkbook.Unprotect Password:=Pwd
ElseIf msg1 = vbYes Then
Do
msg2 = InputBox("Please Enter the Password", "Password Checker", vbOKOnly)
Loop Until msg2 = Pwd
Worksheets("Sensitive Sheet 1").Visible = True
Worksheets("Sensitive Sheet 2").Visible = True
Worksheets("Standard Sheet 1").Visible = xlVeryHidden
Worksheets("Standard Sheet 2").Visible = xlVeryHidden
End If
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:="Macro Enabled Excel Files (*.xlsm), *.xlsm")
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 WS.Name <> "Sensitive Sheet 1" And WS.Name <> "Sensitive Sheet 2" Then
If Not WS.Name = WelcomePage Then WS.Visible = xlSheetVisible
End If
Next WS
Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub