我正在搜索通过用户名授予访问权限的代码,并找到了 user5836742 发布的问题和 PeterT 给出的答案。使用了它不起作用的代码,我删除了测试宏并且它起作用了。我已经复制了我在下面使用的代码。我的问题是使用这种方法它只会显示指定的工作表。但是用户可以右键单击并取消隐藏其他工作表。我们可以为此做些什么?
===代码===
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
如果您想防止用户取消隐藏它们,您必须使用xlSheetVeryHidden
而不是xlSheetHidden
。
或者,您可以使用Workbook.Protect 方法保护您的工作簿。但是请注意,在每次更改可见性之前,您都需要取消保护它sh.Visible = xlSheetVisible
。
在这两种情况下,请注意,总会有一个解决方法,如果用户知道如何使用 VBA,则始终可以使隐藏的工作表可见。隐藏工作表不是对您的数据的安全保护。
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句