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