Fatal编程技术网
  • excel/
  • 限制对Excel工作表的查看权限

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

excel vba

限制对Excel工作表的查看权限,excel,vba,password-protection,restriction,Excel,Vba,Password Protection,Restriction,我认为这在Excel中是一个很容易使用的函数，但要实现一个简单的过程来限制对更大工作簿中特定工作表的访问，却出人意料地困难 有几种方法可以提示初始密码以打开同一工作簿的不同版本。但我想让所有用户都能使用相同的工作簿，但限制对某些工作表的访问。当然有一个密码保护功能，要求用户输入密码才能查看工作表。而不是基于不同的用户创建同一工作簿的多个版本 我尝试了以下方法，但它不会提示密码以访问该工作表 Private Sub Workbook_SheetActivate(ByVal Sh As Object

我认为这在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
我这样做对吗？

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

ActiveWorkbook.Sheets("YourWorkSheet").Visible = xlSheetVeryHidden
根据评论，这听起来不像是一个安全问题，而是一个便利问题。因此，当考虑在项目中实现此功能时，请记住，如果有任何恶意意图获取未经授权的访问，则此功能很容易被破坏

首先，我推荐一个通用着陆区。打开工作簿后立即显示的主工作表。为此，我们将使用
Workbook\u 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
这会将文件路径拆分为一个句点
，并在文件名可能包含其他句点的情况下获取句点
（UBound（拆分（文件名“.”））
。如果扩展名不匹配
xlsm
，则中止保存操作

最后，通过所有检查后，您可以保存文档：

Me.SaveAs .SelectedItems(1), 52
因为我们已经用上面的行保存了它，所以我们可以继续设置
Cancel=True
并退出例程

完整代码（放置在工作表obj模块中）： 
Private子工作簿\u保存前（ByVal SaveAsUI为布尔值，Cancel为布尔值）
错误转到安全出口
如果是SaveAsUI那么
使用Application.FileDialog（msoFileDialogSaveAs）
显示
如果.SelectedItems.Count=0，则
取消=真
其他的
暗文件名$
fileName=.SelectedItems（1）
如果拆分（文件名“.”）（UBound（拆分（文件名“.”））“xlsm”，则
MsgBox“您必须将其另存为.xlsm文档。文档已”&_
“未保存”，VBS严重
取消=真
其他的
Application.EnableEvents=False
Application.DisplayAlerts=False
Me.SaveAs.SelectedItems（1），52
取消=真
如果结束
如果结束
以
其他的
出口接头
如果结束
安全出口：
Application.EnableEvents=True
Application.DisplayAlerts=True
如果错误号为0，则
调试。打印时间；错误描述
MsgBox错误描述，标题：=“错误号”&错误号
如果结束
端接头
我同意Mathieu Guindon的建议，即任何VBA试图“限制查看Excel工作表的权限”都是站不住脚的，正如Mathieu Guindon所解释的那样。此外，如果文件是使用Excel option宏安全级别而不是最低安全级别打开的，则包含该选项的任何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
您将希望对VBA项目进行密码保护，这样用户就不会隐藏该表，尽管您希望使用实际的工具，如Unviewable+（无关联），来保护VBA，而这不会在半秒钟内被任何只研究“破解VBA密码”的人打败。@mdialogo，我不想按照comments@MathieuGuindon. 完全同意。如前所述。这不是一种加密方法。只是一个初始屏幕，这张纸是受限制的。大多数用户点击它是偶然的，或者只是碰运气。如果他们足够努力，他们会成功的，但这代表了一个不同的问题。我只是在一个初步的屏幕“它需要Kutools”…不，这里的一切都是普通的VBA。而且保护也毫无用处（在输入框上按Ctrl+Break可以直接找到密码中的硬编码密码）。@MathieuGuindon。同意。这不是一种万无一失的保护方法。这更像是一个初步阶段。如果没有权限的人点击了错误的工作表，这取决于你为什么这么做。Excel不是设计成这样工作的。如果有人可以访问一个文件，那么他们可以访问所有文件。可以使用链接表创建主工作簿的不同视图。然后，每个用户角色都会有自己的视图，而完整的数据仍保留在其当前工作表中。我认为我们还需要防止另存为.xlsx格式，因为它会完全删除所有保护宏。好建议，@PatricK。我确信我可以使用
BeforeSave（）
事件快速组合一些东西。 
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

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