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

這應該有效。 我的計數邏輯雖然草率，但它確實有效