这不是一个简单的问题 - 答案解决了 VBA 中几个令人沮丧的漏洞。
VBA.InputBox 函数创建一个“模态对话框”,在您需要 VBA 获取窗口句柄并调用某些或其他 API 函数时,该对话框使应用程序的 VBA 代码处于等待状态。
当“模态”状态被释放、允许 VBA 再次运行命令和 API 函数时,InputBox 已经消失。
幸运的是,“manish1239”于 2003 年 10 月发现了一种解决方法,他在Xtreme Visual Basic 讲座 http://www.xtremevbtalk.com/archive/index.php/t-112708.html:他将您需要运行的代码放入 VBA 函数中,该函数使用来自 API 计时器的延迟回调围绕该等待状态运行。
我使用他的代码在 VBA InputBox 中设置“PasswordChars”:这是一个需要 InputBox 窗口句柄的 API 调用,您可以根据需要调整代码
Public Function InputBoxPassword(Prompt As String, _
Optional Default As String = vbNullString, _
Optional XPos, Optional YPos, _
Optional HelpFile, Optional HelpContext _
) As String
On Error Resume Next
' 复制 VBA InputBox 函数的功能,并使用用户的
' 键入的输入显示为星号。对话框的“标题”参数
' 在此实现中,标题被硬编码为“需要密码”。
' 必需函数:TimerProcInputBox
' 必需的 API 声明:FindWindow、FindWindowEx、SetTimer、KillTimer
” 奈杰尔·赫弗南,2015 年 1 月,
' **** **** **** *** 此代码属于公共领域 **** **** **** ****
' 基于用户 'manish1239' 在 Xtreme Visual Basic Talk 中发布的代码
” 2003 年 10 月http://www.xtremevbtalk.com/archive/index.php/t-112708.html http://www.xtremevbtalk.com/archive/index.php/t-112708.html
' 编码注释:我们将 'Set PasswordChar' 消息发送到文本框编辑
' VBA“InputBox”对话框中的窗口。这不是一个简单的任务:
' InputBox 是同步的,是一个“模态对话框”,它使我们的应用程序
' 在我们需要调用 Send 的同时,VBA 代码处于等待状态
'消息API函数。因此它通过 API 计时器的延迟回调来运行
' 警告:网上发布的许多 64 位 API 声明都是不正确的
' 和none其中对于指针安全定时器 API 函数来说是正确的。
出错时继续下一步
SetTimer 0&, 0&, 10&, TimerProcInputBox 的地址
输入框密码 = 输入框(提示, _
PASSBOX_INPUT_CAPTION, _
默认, _
XPos、YPos、_
帮助文件、帮助上下文)
结束功能
#If VBA7 And Win64 then '64位Windows下的64位Excel'使用LongLong和LongPtr
' 请注意,wMsg 始终是 WM_TIMER 消息,适合长整型
Public Sub TimerProcInputBox(ByVal hwnd As LongPtr, _
ByVal wMsg 只要,_
ByValid idEvent As LongPtr, _
ByVal dwTime As LongLong)
出错时继续下一步
' REQUIRED for Function InputBoxPassword
' https://msdn.microsoft.com/en-US/library/windows/desktop/ms644907(v=vs.85).aspx
KillTimer hWndIbox, idEvent
Dim hWndIbox As LongPtr ' Handle to VBA InputBox
hWndIbox = FindWindowEx(FindWindow("#32770", PASSBOX_INPUT_CAPTION), 0, "Edit", "")
If hWndIbox <> 0 Then
SendMessage hWndIbox, EM_SETPASSWORDCHAR, Asc("*"), 0&
End If
End Sub
#ElseIf VBA7 那么“32 位 Office 中的 VBA7”仅使用 LongPtr
Public Sub TimerProcInputBox(ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal idEvent As LongPtr, _
ByVal dwTime As Long)
On Error Resume Next
' REQUIRED for Function InputBoxPassword
' https://msdn.microsoft.com/en-US/library/windows/desktop/ms644907(v=vs.85).aspx
Dim hWndIbox As LongPtr ' Handle to VBA InputBox
KillTimer hwnd, idEvent
hWndIbox = FindWindowEx(FindWindow("#32770", PASSBOX_INPUT_CAPTION), 0, "Edit", "")
If hWndIbox <> 0 Then
SendMessage hWndIbox, EM_SETPASSWORDCHAR, Asc("*"), 0&
End If
End Sub
#Else ' 32 位 Excel
Public Sub TimerProcInputBox(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
On Error Resume Next
' REQUIRED for Function InputBoxPassword
' https://msdn.microsoft.com/en-US/library/windows/desktop/ms644907(v=vs.85).aspx
Dim hWndIbox As Long ' Handle to VBA InputBox
KillTimer hwnd, idEvent
hWndIbox = FindWindowEx(FindWindow("#32770", PASSBOX_INPUT_CAPTION), 0&, "Edit", "")
If hWndIbox <> 0 Then
SendMessage hWndIbox, EM_SETPASSWORDCHAR, Asc("*"), 0&
End If
End Sub
#End If