限制对Excel工作表的查看访问权限



我原以为这是Excel中一个很容易使用的函数,但在更大的工作簿中实现一个限制访问特定工作表的简单过程却非常困难。

有几种方法可以提示初始密码打开同一工作簿的不同版本。但我希望所有用户的工作簿保持相同,但限制对某些工作表的访问。当然,有一个密码保护功能,需要用户输入密码才能查看工作表。而不是基于不同的用户创建同一工作簿的多个版本。

我已经尝试了以下操作,但它不会提示密码来访问表单

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

我这样做对吗?

根据评论,这与其说是安全问题,不如说是便利问题。因此,在考虑将其实现到您的项目中时,请记住,如果有任何恶意意图获得未经授权的访问,这很容易被破坏。

首先,我建议使用通用着陆区。打开工作簿后立即显示的主工作表。为此,我们将使用Workbook_Open()事件并从中激活一个工作表。

如果需要,这可以是一个隐藏的工作表,这将取决于您。

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

接下来,我们应该决定在尝试访问新工作表时应该发生什么。在下面的方法中,一旦激活工作表,它将自动将用户重定向回上次使用的工作表,直到成功尝试密码为止。

我们可以在模块范围的变量中跟踪最后使用的表,在本例中,该变量将被命名为lastUsedSheet。任何时候成功更改工作表,此变量都将自动设置为该工作表-这样,当有人试图访问另一个工作表时,它会将他们重定向回上一个工作单,直到成功输入密码。

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事件将继续激发,因此禁用事件是必要的。


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并退出例程。

完整代码(将放在工作表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大喊建议

如果你想限制对工作表的访问,你可以隐藏它:

ActiveWorkbook.Sheets("YourWorkSheet").Visible = xlSheetVeryHidden

我同意Mathieu Guindon的观点,即任何VBA试图"限制对Excel工作表的查看访问"都是站不住脚的,正如Mathieu Gindon所解释的那样此外,如果使用Excel选项"宏安全级别"(而非最低级别(打开文件,则包括此选项在内的任何VBA代码都注定会失败

然而,为了简化,我更喜欢使用工作簿打开事件和受限工作表的工作表激活。使用工作簿工作表激活事件将触发密码提示,即使在具有查看权限的用户在工作表之间切换时也是如此。

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

最新更新