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

首先,我建议 共同着陆区 . 打开工作簿后立即显示的主工作表。为此,我们将使用 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 或 另存为 . 您可以使用Boolean属性来完成此操作 SaveAsUI 它包含在事件本身中。如果该值为 True 那是一个 另存为 事件-这意味着我们需要执行额外的检查,以确保文件类型不会从“保存”对话框中意外更改。如果值是 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

既然我们已经用上面的行保存了它,我们可以继续设置 取消=真 然后退出程序。

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

如果要限制对工作表的访问,可以将其隐藏:

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

我同意Mathieu Guindon的观点,即任何vba试图“限制查看Excel工作表”的行为都是轻率的,正如Mathieu Guindon所解释的那样。 此外,如果使用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