指定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