指定Windows用戶名tu一次取消保護所有工作表

Question

我想編寫一個簡單的宏來一次取消所有工作表保護。 很好 但我想做2個選擇。

1，使用inputbox寫密碼。 簡單

我需要您幫助的第二個地方是使用Windows用戶名來定義哪些用戶無需密碼即可取消保護（密碼已在已定義的代碼中）。

如何使用Environ.user定義可以使用該宏的用戶？

例如，用戶：第一個“ hackla”和第二個“ klaud”

我的基本代碼如下：

Sub TabelleEntsperren()
  Dim strPassw As String
  Dim wSheet As Worksheet

strPassw = "Athens"

 For Each wSheet In ActiveWorkbook.Worksheets
 wSheet.Unprotect Password:=strPassw
Next wSheet

End Sub

Answer 1

你的意思是這樣嗎？

Sub TabelleEntsperren()
    Const strPassw As String = "yourPassword"
    Const usr1 As String = "hackla"
    Const usr2 As String = "klaud"

    Dim wSheet As Worksheet
    Dim isTrustedUser As Boolean
    Dim currentUsr As String

    currentUsr = Environ("username")
    isTrustedUser = currentUsr = usr1 Or currentUsr = usr2

    For Each wSheet In ActiveWorkbook.Worksheets
        If isTrustedUser Then wSheet.Unprotect Password:=strPassw
    Next wSheet

End Sub

Answer 2

Option Explicit

'Private API declarations
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#Else
    Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBudffer As String, nSize As Long) As Long
#End If

'To get the computer name
Public Function getActiveComputerName() As String
Dim cn As String, ls As Long, res As Long

cn = String(1024, 0)
ls = 1024
res = GetComputerName(cn, ls)
If res <> 0 Then
    getActiveComputerName = Mid$(cn, 1, InStr(cn, Chr$(0)) - 1)
Else
    getActiveComputerName = ""
End If

End Function

'To get the identifier for the active user
Public Function getActiveUserName() As String
Dim cn As String, ls As Long, res As Long

cn = String(1024, 0)
ls = 1024
res = GetUserName(cn, ls)
If res <> 0 Then
    getActiveUserName = Mid$(cn, 1, InStr(cn, Chr$(0)) - 1)
Else
    getActiveUserName = ""
End If

End Function