Vba 在多个工作簿中使用相同的热键

我在几个工作簿模板中有一个VBA脚本，用于解锁当前（活动）工作表。我使用相同的热键，这样允许使用宏的用户就不必记住哪个热键允许他们解锁工作簿

Sub Lock_Unlock() Dim CurrentUser As String 'holds the current users Windows login Dim Approved As String Approved = "|user1|user2|user3|"

 'Give CurrentUser it's value
 CurrentUser = Environ$("username")

'Check if the user is approved
If InStr(1, Approved, CurrentUser) > 0 Then
    'The user can use this macro. Check if the sheet is currently locked
    If ActiveSheet.ProtectContents = True Then
        'It is, unlock
        ActiveSheet.Unprotect Password:=PW()
    Else
        'It isn't, relock
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, Password:=PW()
    End If
'Not a user approved to use this macro, don't do anything
End If

End Sub

Function PW() As String
PW = "password"
End Function

这通常不会引起任何问题，因为大多数用户一次打开的工作簿不超过一个（而且很可能不会使用热键）。问题是，如果我打开了多个工作簿，并尝试使用热键运行VBA脚本，我当前会得到一个VBA脚本的随机实例。这会导致问题，因为工作簿之间的密码确实不同，因此如果热键启动WB X中的VBA脚本，而我在WB Y中，则会出现错误

Sub Lock_Unlock() Dim CurrentUser As String 'holds the current users Windows login Dim Approved As String Approved = "|user1|user2|user3|"

 'Give CurrentUser it's value
 CurrentUser = Environ$("username")

'Check if the user is approved
If InStr(1, Approved, CurrentUser) > 0 Then
    'The user can use this macro. Check if the sheet is currently locked
    If ActiveSheet.ProtectContents = True Then
        'It is, unlock
        ActiveSheet.Unprotect Password:=PW()
    Else
        'It isn't, relock
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, Password:=PW()
    End If
'Not a user approved to use this macro, don't do anything
End If

End Sub

Function PW() As String
PW = "password"
End Function

说到这里，有没有办法让热键上的活动工作簿中的VBA脚本成为所使用的脚本

Sub Lock_Unlock() Dim CurrentUser As String 'holds the current users Windows login Dim Approved As String Approved = "|user1|user2|user3|"

 'Give CurrentUser it's value
 CurrentUser = Environ$("username")

'Check if the user is approved
If InStr(1, Approved, CurrentUser) > 0 Then
    'The user can use this macro. Check if the sheet is currently locked
    If ActiveSheet.ProtectContents = True Then
        'It is, unlock
        ActiveSheet.Unprotect Password:=PW()
    Else
        'It isn't, relock
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, Password:=PW()
    End If
'Not a user approved to use this macro, don't do anything
End If

End Sub

Function PW() As String
PW = "password"
End Function

根据Alter的请求，这是我的锁定解锁VBA脚本的净化版本 Sub Lock_Unlock() Dim CurrentUser As String 'holds the current users Windows login Dim Approved As String Approved = "|user1|user2|user3|"

 'Give CurrentUser it's value
 CurrentUser = Environ$("username")

'Check if the user is approved
If InStr(1, Approved, CurrentUser) > 0 Then
    'The user can use this macro. Check if the sheet is currently locked
    If ActiveSheet.ProtectContents = True Then
        'It is, unlock
        ActiveSheet.Unprotect Password:=PW()
    Else
        'It isn't, relock
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, Password:=PW()
    End If
'Not a user approved to use this macro, don't do anything
End If

End Sub

Function PW() As String
PW = "password"
End Function

---

我将这样做，将密码模块化为getFunction

前

现在，当您需要密码调用

Application.Run（ActiveWorkbook.Name&“！getPassword”）

时，无论从哪个工作簿运行宏，都将确保从活动工作簿检索密码

前

---

选项2：检查此工作簿是否为ActiveWorkbook，如果不是，则使用与获取密码相同的方法从ActiveWorkbook调用宏。

如果您愿意包含此代码，我将非常感兴趣。我有一个类似的问题，我需要解决，如果我用你的作为基础，它可以节省我很多时间哦！为什么我没想到呢？实际上，我已经从您建议的函数中传回了密码（使它更容易不时更新）。谢谢你的帮助！