VBA Excel 用户名授予访问权限

Question

寻求一点帮助，我有一个 excel 文档，该文档应该只授予某些用户访问权限，所有员工都有一个用户名，并且当他们输入任何显示其条目的信息时。 我希望保护该文件，以便只有某些员工可以访问。 到目前为止我有

Private Sub Workbook_Open()
 Dim Users As Variant
 Dim UName As String
 Dim UFind As Variant
 Users = Array("JBLOGS", "DOEJOHN", "ASmith", "JanDoe")

 UName = Environ("UserName")
 On Error Resume Next
 UFind = WorksheetFunction.Match(UName, Users, 0)
 If Err <> 0 Then
     MsgBox "You are not authorised to use this Workbook"
     ThisWorkbook.Close SaveChanges:=False
 End If
 End Sub

这很好，但我希望它位于自己的工作表上，即标题为“用户”的列，然后是可以轻松添加的用户列表。

我还想知道是否可以将某些用户限制在某些工作表中，例如，John Doe 在非洲，Jane 在美国，我可以限制他们只能看到标题为“Africa”和“America”的工作表吗？

看了一眼，什么也看不到，所以不确定它是否容易完成...

Answer 1

我建议创建一个隐藏的工作表来保存您的用户名列表，如果需要，您甚至可以使用密码保护隐藏的工作表。 此外，您可以将用户名列表展开为一个表格，其中列出了每个用户可以查看的工作表。 该表不允许的任何工作表也可以对该用户隐藏（当然，对于具有授权访问权限的其他用户，也可以取消隐藏）。 作为旁注，您可能会发现将表中的用户名与环境变量进行不区分大小写的比较很有用 - 这有时让我感到困惑。

EDIT1：这是一个让您入门的示例：

创建一个名为“AuthUsers”的工作表，然后创建一个名为“UserTable”的表。 在表中定义两列，第一列称为“Users”，第二列称为“Sheets”。

EDIT2：添加了ViewAuthorizedSheets方法来隐藏/查看适当的工作表并更新测试子。 从Worksheet_Open调用时，这也能正常Worksheet_Open 。

Option Explicit

Sub test()
    Debug.Print "user is authorized = " & IsUserAuthorized(Environ("UserName"))
    ViewAuthorizedSheets Environ("UserName")
    If IsUserAuthorized(Environ("UserName")) Then
        Debug.Print "authorized sheets = " & GetAuthorizedSheets(Environ("UserName"))
    Else
        MsgBox "User is not authorized to view any sheets.", vbCritical + vbOKOnly
    End If
End Sub

Public Sub ViewAuthorizedSheets(uname As String)
    Dim authSheets As String
    Dim sh As Worksheet
    uname = Environ("UserName")
    authSheets = GetAuthorizedSheets(uname)
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "AuthUsers" Then
            If InStr(1, authSheets, sh.Name, vbTextCompare) > 0 Then
                sh.Visible = xlSheetVisible
            Else
                sh.Visible = xlSheetHidden
            End If
        End If
    Next sh
End Sub

Function IsUserAuthorized(uname As String) As Boolean
    Dim ws As Worksheet
    Dim userTbl As ListObject
    Dim userList As Range
    Dim allowedUser As Variant
    Dim allowed As Boolean

    Set ws = ThisWorkbook.Sheets("AuthUsers")
    Set userTbl = ws.ListObjects("UserTable")
    Set userList = userTbl.ListColumns("Users").DataBodyRange
    allowed = False
    For Each allowedUser In userList
        If LCase(allowedUser) = LCase(uname) Then
            allowed = True
            Exit For
        End If
    Next allowedUser
    Set userList = Nothing
    Set userTbl = Nothing
    Set ws = Nothing
    IsUserAuthorized = allowed
End Function

Function GetAuthorizedSheets(uname As String) As String
    Dim ws As Worksheet
    Dim userTbl As ListObject
    Dim userList As Range
    Dim allowedUser As Variant
    Dim allowed As String

    Set ws = ThisWorkbook.Sheets("AuthUsers")
    Set userTbl = ws.ListObjects("UserTable")
    Set userList = userTbl.DataBodyRange
    allowed = False
    For Each allowedUser In userList.Columns(1).Cells
        If LCase(allowedUser) = LCase(uname) Then
            allowed = allowedUser.Offset(0, 1).value
            Exit For
        End If
    Next allowedUser
    Set userList = Nothing
    Set userTbl = Nothing
    Set ws = Nothing
    GetAuthorizedSheets = allowed
End Function

在您的ThisWorkbook模块中，只需通过以下方式访问调用

Option Explicit

Private Sub Workbook_Open()
    ViewAuthorizedSheets Environ("UserName")
End Sub

Answer 2

Private Sub Workbook_Open()

    Dim EmpArray(3) As String
    Dim Count As Integer

    EmpArray(0) = "dzcoats"
    EmpArray(1) = "cspatric"
    EmpArray(2) = "eabernal"
    EmpArray(3) = "lcdotson"

    Count = 0

    For i = LBound(EmpArray) To UBound(EmpArray)
    If Application.UserName = EmpArray(i) Then Count = Count = 1
    Next i

    If Count = 0 Then
        MsgBox ("You dont have access to this file")
        ThisWorkbook.Close SaveChanges:=False
    End If

End Sub

这应该有效。 我的计数逻辑虽然草率，但它确实有效