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

Question

我认为这将是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

我这样做正确吗？

Answer 1

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

首先，我建议一个公共着陆区。打开工作簿后立即显示的主工作表。为此，我们将使用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事件在成功更改工作表后仍会继续触发，因此必须禁用事件。

---

防止在SaveAs ¹

期间文件类型更改

通过限制文件保存类型，可以进一步保护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

---

_{¹ 向PatricK大喊建议}

Answer 2

如果您想限制对工作表的访问，则可以将其隐藏：

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

Answer 3

我同意Mathieu Guindon的看法，正如Mathieu Guindon所解释的那样，任何VBA“限制查看对Excel工作表的访问”的企图都是脆弱的。 此外，如果使用最低级别以外的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