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”的表。在表中定义两列，第一列称为“用户”，第二列称为“表格”。

EDIT2：添加了ViewAuthorizedSheets方法来隐藏/查看相应的工作表并更新了测试子。从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

这应该有效。我的计数逻辑虽然很邋but但它可以解决这个问题

VBA Excel用户名授予访问权限

2 个答案: