限制对 Excel 工作表的查看权限
Restrict viewing access to an Excel worksheet
我认为这在 Excel 中是一个很容易使用的功能，但在较大的工作簿中实施限制对特定工作 sheet 的访问的简单过程却出奇地困难。
有几种方法可以提示输入初始密码来打开同一工作簿的不同版本。但我想让所有用户的工作簿保持一致，但限制对某些 sheet 的访问。肯定有密码保护功能，需要用户输入密码才能查看sheet。而不是根据不同的用户创建同一工作簿的多个版本。
我尝试了以下方法，但它没有提示输入密码来访问 sheet
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
Dim MySheet As Worksheet
MySheet = "COMMUNICATION"
If ActiveSheet.Name = MySheet Then
ActiveSheet.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "MyPass" Then
Sheets(MySheet).Visible = True
Application.EnableEvents = False
Sheets(MySheet).Select
Application.EnableEvents = True
End If
End If
Sheets(MySheet).Visible = True
End Sub
我这样做对吗？
如果您想限制对工作表的访问，您可以将其隐藏：
ActiveWorkbook.Sheets("YourWorkSheet").Visible = xlSheetVeryHidden
根据评论，这听起来像是一个便利问题，而不是安全问题。因此，在考虑将其实施到您的项目中时请记住，如果有任何恶意意图获得未经授权的访问，这很容易被破坏。
首先，我会推荐一个共同着陆区。打开工作簿后立即显示的主要工作sheet。为此，我们将使用 Workbook_Open() 事件并从那里激活一个 sheet。
这可以是隐藏的 sheet 如果需要，这将由您决定。
Option Explicit
Private lastUsedSheet As Worksheet
Private Sub Workbook_Open()
Set lastUsedSheet = Me.Worksheets("MainSheet")
Application.EnableEvents = False
lastUsedSheet.Activate
Application.EnableEvents = True
End Sub
接下来，我们应该决定在尝试访问新的 sheet 时 应该 发生什么。在下面的方法中，一旦 sheet 被激活，它将自动将用户重定向回上次使用的 sheet，直到密码尝试成功。
我们可以在模块范围的变量中跟踪上次使用的 sheet，在此示例中，该变量将被命名为 lastUsedSheet。任何时候一个作品 sheet 被成功更改，这个变量将自动设置为那个作品 sheet - 这样当有人试图访问另一个 sheet 时，它会将他们重定向回先sheet直到密码输入成功。
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error GoTo SafeExit
Application.EnableEvents = False
' Error protection in case lastUsedSheet is nothing
If lastUsedSheet Is Nothing Then
Set lastUsedSheet = Me.Worksheets("MainSheet")
End If
' Allow common sheets to be activated without PW
If Sh.Name = "MainSheet" Then
Set lastUsedSheet = Sh
Sh.Activate
GoTo SafeExit
Else
' Temporarily send the user back to last sheet until
' Password has been successfully entered
lastUsedSheet.Activate
End If
' Set each sheet's password
Dim sInputPW As String, sSheetPW As String
Select Case Sh.Name
Case "Sheet1"
sSheetPW = "123456"
Case "Sheet2"
sSheetPW = "987654"
End Select
' Create a loop that will keep prompting password
' until successful pw or empty string entered
Do
sInputPW = InputBox("Please enter password for the " & _
"worksheet: " & Sh.Name & ".")
If sInputPW = "" Then GoTo SafeExit
Loop While sInputPW <> sSheetPW
Set lastUsedSheet = Sh
Sh.Activate
SafeExit:
Application.EnableEvents = True
If Err.Number <> 0 Then
Debug.Print Time; Err.Description
MsgBox Err.Description, Title:="Error # " & Err.Number
End If
End Sub
旁注，禁用事件是必要的，因为您的 Workbook_SheetActivate 事件将在 sheet 更改成功后继续触发。
防止在 SaveAs1
期间更改文件类型
您可以通过限制文件保存类型进一步防止意外删除 VBA 代码。这可以使用 Workbook_BeforeSave() 事件来完成。这是一个潜在问题的原因是，另存为未启用宏的工作簿会清除代码，这将阻止您刚刚在上面实现的密码保护功能。
首先，我们需要检查这是 Save 还是 SaveAs。您可以使用事件本身附带的布尔值 属性 SaveAsUI 来完成此操作。如果此值为 True，则它是一个 SaveAs 事件 - 这意味着我们需要执行额外的检查以确保文件类型不会在保存对话框中被意外更改。如果值为 False，那么这是一个正常的保存，我们可以绕过这些检查，因为我们知道工作簿将被保存为 .xlsm.
类型
初步检查后，我们将使用 Application.FileDialog().Show 显示对话框。
之后，我们将检查用户是否取消了操作.SelectedItems.Count = 0或点击了保存。如果用户单击取消，那么我们只需设置 Cancel = True，工作簿将不会保存。
我们继续检查用户使用此行选择的扩展类型：
If Split(fileName, ".")(UBound(Split(fileName, "."))) <> "xlsm" Then
这将按句点 . 拆分文件路径，并在文件名可能包含其他句点的情况下获取句点 (UBound(Split(fileName, "."))) 的最后一个实例。如果扩展名不匹配 xlsm，那么我们将中止保存操作。
最后，所有检查都通过后，就可以保存文档了：
Me.SaveAs .SelectedItems(1), 52
因为我们已经用上面的行保存了它，我们可以继续设置Cancel = True并退出例程。
完整代码(放在Worksheet obj模块中):
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo SafeExit
If SaveAsUI Then
With Application.FileDialog(msoFileDialogSaveAs)
.Show
If .SelectedItems.Count = 0 Then
Cancel = True
Else
Dim fileName$
fileName = .SelectedItems(1)
If Split(fileName, ".")(UBound(Split(fileName, "."))) <> "xlsm" Then
MsgBox "You must save this as an .xlsm document. Document has " & _
"NOT been saved", vbCritical
Cancel = True
Else
Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs .SelectedItems(1), 52
Cancel = True
End If
End If
End With
Else
Exit Sub
End If
SafeExit:
Application.EnableEvents = True
Application.DisplayAlerts = True
If Err.Number <> 0 Then
Debug.Print Time; Err.Description
MsgBox Err.Description, Title:="Error # " & Err.Number
End If
End Sub
1 向 PatricK 提出建议
我同意 Mathieu Guindon 的观点，如 Mathieu Guindon 所解释的，任何 VBA 对 "Restrict viewing access to an Excel worksheet" 的尝试都是站不住脚的。 此外，如果使用 Excel 选项打开文件而不是最低的宏安全级别，任何包含此的 VBA 代码都将失败。
不过为了简单，我更喜欢使用工作簿打开事件和Sheet激活受限sheet。使用工作簿 Sheet 激活事件将触发密码提示，即使在具有查看权限的用户在 sheet 之间切换时也是如此。
Private Sub Workbook_Open()
Sheets("COMMUNICATION").Visible = xlSheetHidden
End Sub
Public ViewAccess As Boolean 'In restricted sheet's activate event
Private Sub Worksheet_Activate()
If ViewAccess = False Then
Me.Visible = xlSheetHidden
response = Application.InputBox("Password", xTitleId, "", Type:=2)
If response = "123" Then
Me.Visible = xlSheetVisible
ViewAccess = True
End If
End If
End Sub
我认为这在 Excel 中是一个很容易使用的功能，但在较大的工作簿中实施限制对特定工作 sheet 的访问的简单过程却出奇地困难。
有几种方法可以提示输入初始密码来打开同一工作簿的不同版本。但我想让所有用户的工作簿保持一致，但限制对某些 sheet 的访问。肯定有密码保护功能，需要用户输入密码才能查看sheet。而不是根据不同的用户创建同一工作簿的多个版本。
我尝试了以下方法，但它没有提示输入密码来访问 sheet
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
Dim MySheet As Worksheet
MySheet = "COMMUNICATION"
If ActiveSheet.Name = MySheet Then
ActiveSheet.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "MyPass" Then
Sheets(MySheet).Visible = True
Application.EnableEvents = False
Sheets(MySheet).Select
Application.EnableEvents = True
End If
End If
Sheets(MySheet).Visible = True
End Sub
我这样做对吗？
如果您想限制对工作表的访问，您可以将其隐藏：
ActiveWorkbook.Sheets("YourWorkSheet").Visible = xlSheetVeryHidden
根据评论，这听起来像是一个便利问题，而不是安全问题。因此，在考虑将其实施到您的项目中时请记住，如果有任何恶意意图获得未经授权的访问，这很容易被破坏。
首先，我会推荐一个共同着陆区。打开工作簿后立即显示的主要工作sheet。为此，我们将使用 Workbook_Open() 事件并从那里激活一个 sheet。
这可以是隐藏的 sheet 如果需要，这将由您决定。
Option Explicit
Private lastUsedSheet As Worksheet
Private Sub Workbook_Open()
Set lastUsedSheet = Me.Worksheets("MainSheet")
Application.EnableEvents = False
lastUsedSheet.Activate
Application.EnableEvents = True
End Sub
接下来，我们应该决定在尝试访问新的 sheet 时 应该 发生什么。在下面的方法中，一旦 sheet 被激活，它将自动将用户重定向回上次使用的 sheet，直到密码尝试成功。
我们可以在模块范围的变量中跟踪上次使用的 sheet，在此示例中，该变量将被命名为 lastUsedSheet。任何时候一个作品 sheet 被成功更改，这个变量将自动设置为那个作品 sheet - 这样当有人试图访问另一个 sheet 时，它会将他们重定向回先sheet直到密码输入成功。
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error GoTo SafeExit
Application.EnableEvents = False
' Error protection in case lastUsedSheet is nothing
If lastUsedSheet Is Nothing Then
Set lastUsedSheet = Me.Worksheets("MainSheet")
End If
' Allow common sheets to be activated without PW
If Sh.Name = "MainSheet" Then
Set lastUsedSheet = Sh
Sh.Activate
GoTo SafeExit
Else
' Temporarily send the user back to last sheet until
' Password has been successfully entered
lastUsedSheet.Activate
End If
' Set each sheet's password
Dim sInputPW As String, sSheetPW As String
Select Case Sh.Name
Case "Sheet1"
sSheetPW = "123456"
Case "Sheet2"
sSheetPW = "987654"
End Select
' Create a loop that will keep prompting password
' until successful pw or empty string entered
Do
sInputPW = InputBox("Please enter password for the " & _
"worksheet: " & Sh.Name & ".")
If sInputPW = "" Then GoTo SafeExit
Loop While sInputPW <> sSheetPW
Set lastUsedSheet = Sh
Sh.Activate
SafeExit:
Application.EnableEvents = True
If Err.Number <> 0 Then
Debug.Print Time; Err.Description
MsgBox Err.Description, Title:="Error # " & Err.Number
End If
End Sub
旁注，禁用事件是必要的，因为您的 Workbook_SheetActivate 事件将在 sheet 更改成功后继续触发。
防止在 SaveAs1
期间更改文件类型
您可以通过限制文件保存类型进一步防止意外删除 VBA 代码。这可以使用 Workbook_BeforeSave() 事件来完成。这是一个潜在问题的原因是，另存为未启用宏的工作簿会清除代码，这将阻止您刚刚在上面实现的密码保护功能。
首先，我们需要检查这是 Save 还是 SaveAs。您可以使用事件本身附带的布尔值 属性 SaveAsUI 来完成此操作。如果此值为 True，则它是一个 SaveAs 事件 - 这意味着我们需要执行额外的检查以确保文件类型不会在保存对话框中被意外更改。如果值为 False，那么这是一个正常的保存，我们可以绕过这些检查，因为我们知道工作簿将被保存为 .xlsm.
初步检查后，我们将使用 Application.FileDialog().Show 显示对话框。
之后，我们将检查用户是否取消了操作.SelectedItems.Count = 0或点击了保存。如果用户单击取消，那么我们只需设置 Cancel = True，工作簿将不会保存。
我们继续检查用户使用此行选择的扩展类型：
If Split(fileName, ".")(UBound(Split(fileName, "."))) <> "xlsm" Then
这将按句点 . 拆分文件路径，并在文件名可能包含其他句点的情况下获取句点 (UBound(Split(fileName, "."))) 的最后一个实例。如果扩展名不匹配 xlsm，那么我们将中止保存操作。
最后，所有检查都通过后，就可以保存文档了：
Me.SaveAs .SelectedItems(1), 52
因为我们已经用上面的行保存了它，我们可以继续设置Cancel = True并退出例程。
完整代码(放在Worksheet obj模块中):
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo SafeExit
If SaveAsUI Then
With Application.FileDialog(msoFileDialogSaveAs)
.Show
If .SelectedItems.Count = 0 Then
Cancel = True
Else
Dim fileName$
fileName = .SelectedItems(1)
If Split(fileName, ".")(UBound(Split(fileName, "."))) <> "xlsm" Then
MsgBox "You must save this as an .xlsm document. Document has " & _
"NOT been saved", vbCritical
Cancel = True
Else
Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs .SelectedItems(1), 52
Cancel = True
End If
End If
End With
Else
Exit Sub
End If
SafeExit:
Application.EnableEvents = True
Application.DisplayAlerts = True
If Err.Number <> 0 Then
Debug.Print Time; Err.Description
MsgBox Err.Description, Title:="Error # " & Err.Number
End If
End Sub
1 向 PatricK 提出建议
我同意 Mathieu Guindon 的观点，如 Mathieu Guindon 所解释的，任何 VBA 对 "Restrict viewing access to an Excel worksheet" 的尝试都是站不住脚的。 此外，如果使用 Excel 选项打开文件而不是最低的宏安全级别，任何包含此的 VBA 代码都将失败。
不过为了简单，我更喜欢使用工作簿打开事件和Sheet激活受限sheet。使用工作簿 Sheet 激活事件将触发密码提示，即使在具有查看权限的用户在 sheet 之间切换时也是如此。
Private Sub Workbook_Open()
Sheets("COMMUNICATION").Visible = xlSheetHidden
End Sub
Public ViewAccess As Boolean 'In restricted sheet's activate event
Private Sub Worksheet_Activate()
If ViewAccess = False Then
Me.Visible = xlSheetHidden
response = Application.InputBox("Password", xTitleId, "", Type:=2)
If response = "123" Then
Me.Visible = xlSheetVisible
ViewAccess = True
End If
End If
End Sub