VBA Excel用户名授予访问权限

寻找一点帮助，我有一个Excel文件，只应该授予某些用户访问权限，所有员工都有一个用户名，并在他们input任何信息时显示与他们的条目。 我希望能够保护文件，以便只有特定的员工才能访问。 到目前为止，我有

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在美国，我能限制他们只看“非洲”和“美国”

看了看，看不到任何东西，所以不知道它是否容易做到…

Answer 1

我build议创build一个隐藏的工作表来保存你的用户名列表，你甚至可以用密码来保护隐藏的表格。 另外，您可以将您的用户名列表展开到列出每个用户都可以查看的工作表的表格中。 任何被表格拒绝的表格也可能被该用户隐藏（当然，对于具有被授予访问权限的不同用户而言，也不会隐藏）。 作为一个方面的说明，你可能会发现将表的用户名和环境variables进行不区分大小写的比较是有用的 – 这有时会让我感到沮丧。

编辑1：这是一个例子，让你开始：

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

编辑2：添加ViewAuthorizedSheets方法来隐藏/查看适当的工作表，并更新testing子。 从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 

这应该工作。 我的计数逻辑是sl though，但它的确有窍门