3

I think I have a fairly simple question. I'm looking for a method to get the hwnd for an excel input box. I'm automating a process and I'm noticing that a type 8 input box is consistently underneath the excel window (I'm automating excel from another application if that is helpful.). Obviously, I'd like it to show up on top, and I'm attempting to use the SetForegroundWindow function. Any advice?

By request, the only thing I've found that seemed worth trying:

Public Function GetHwnd() as Long
     GetHwnd = Excel.Application.InputBox.hwnd
End Function
4

1 回答 1

2

这不是一个简单的问题 - 答案围绕 VBA 中的几个令人沮丧的空白。

VBA.InputBox 函数创建一个“模态对话框”，在您需要 VBA 获取窗口句柄并调用某些或其他 API 函数的确切时刻，使您的应用程序的 VBA 代码处于等待状态。

当“模态”状态被释放，允许 VBA 再次运行命令和 API 函数时，InputBox 已经消失了。

幸运的是，“manish1239”在 2003 年 10 月发现了一种解决方法，他在Xtreme Visual Basic Talk上发布了一个巧妙的 hack ：他将您需要运行的代码放在围绕该等待状态运行的 VBA 函数中，使用来自API 计时器。

我使用他的代码在 VBA InputBox 中设置“PasswordChars”：这是一个需要 InputBox 窗口句柄的 API 调用，您可以根据需要调整代码

公共函数输入框密码（提示为字符串，_
                                 可选默认为 String = vbNullString, _
                                 可选 XPos，可选 YPos，_
                                 可选的 HelpFile，可选的 HelpContext _
                                 ) 作为字符串
出错时继续下一步



' 复制 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



' 编码说明：我们将 'Set PasswordChar' 消息发送到文本框编辑
' VBA 'InputBox' 对话框中的窗口。这不是一个简单的任务：
' InputBox 是同步的，一个离开我们应用程序的“模态对话框”
' VBA 代码在我们需要调用发送的确切时刻处于等待状态
' 消息 API 函数。所以它通过来自 API Timer 的延迟回调运行



' 警告：网上发布的许多 64 位 API 声明不正确
' 并且它们都不适合指针安全的 Timer API 函数。



出错时继续下一步



SetTimer 0&, 0&, 10&, AddressOf TimerProcInputBox



输入框密码 = 输入框（提示，_
                            PASSBOX_INPUT_CAPTION，_
                            默认， _
                            XPos，YPos，_
                            帮助文件，帮助上下文）



结束功能



#If VBA7 And Win64 Then ' 64-bit Excel under 64-bit windows ' 使用 LongLong 和 LongPtr
                            ' 请注意 wMsg 始终是 WM_TIMER 消息，它适合 Long
    公共子 TimerProcInputBox(ByVal hwnd As LongPtr, _
                                 ByVal wMsg 只要，_
                                 ByVal 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 Then ' VBA7 in 32-Bit Office ' 仅使用 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




＃万一

您将需要以下声明：

选项显式
选项专用模块



#If VBA7 And Win64 Then ' 64-bit Excel under 64-bit windows ' 使用 LongLong 和 LongPtr



Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                                (ByVal hWnd1 As LongPtr, _
                                 ByVal hWnd2 As LongPtr, _
                                 ByVal lpsz1 As String, _
                                 ByVal lpsz2 As String _
                                 ) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
                                (ByVal lpClassName As String, _
                                 ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
                                (ByVal hwnd As LongPtr, _
                                 ByVal wMsg As Long, _
                                 ByVal wParam As Long, _
                                 ByRef lParam As Any _
                                 ) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" _
                                (ByVal hwnd As LongPtr, _
                                 ByVal nIDEvent As LongPtr, _
                                 ByVal uElapse As Long, _
                                 ByVal lpTimerFunc As LongPtr _
                                 ) As Long
 Public Declare PtrSafe Function KillTimer Lib "user32" _
                                (ByVal hwnd As LongPtr, _
                                 ByVal nIDEvent As LongPtr _
                                 ) As Long




#ElseIf VBA7 Then 'VBA7 in 32-Bit Office ' 仅使用 LongPtr，LongLong 不可用



Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                                (ByVal hWnd1 As LongPtr, _
                                 ByVal hWnd2 As LongPtr, _
                                 ByVal lpsz1 As String, _
                                 ByVal lpsz2 As String _
                                 ) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
                                (ByVal lpClassName As String, _
                                 ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
                                (ByVal hwnd As LongPtr, _
                                 ByVal wMsg As Long, _
                                 ByVal wParam As Long, _
                                 ByRef lParam As Any _
                                 ) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" _
                                (ByVal hwnd As LongPtr, _
                                 ByVal nIDEvent As Long, _
                                 ByVal uElapse As Long, _
                                 ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" _
                                (ByVal hwnd As LongPtr, _
                                 ByVal nIDEvent As Long) As Long




#Else ' 32 位 Excel



Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                        (ByVal hWnd1 As Long, _
                         ByVal hWnd2 As Long, _
                         ByVal lpsz1 As String, _
                         ByVal lpsz2 As String _
                         ) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                        (ByVal lpClassName As String, _
                         ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                        (ByVal hwnd As Long, _
                         ByVal wMsg As Long, _
                         ByVal wParam As Long, _
                         ByRef lParam As Any _
                         ) As Long
Private Declare Function SetTimer Lib "user32" _
                        (ByVal hwnd As Long, _
                         ByVal nIDEvent As Long, _
                         ByVal uElapse As Long, _
                         ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" _
                        (ByVal hwnd As Long, _
                         ByVal nIDEvent As Long) As Long




＃万一



Private Const PASSBOX_INPUT_CAPTION As String = "需要密码"
Private Const EM_SETPASSWORDCHAR As Long = &HCC
Private Const NV_INPUTBOX 只要 = &H5000&

我将其发布在我的博客 Excellerando 上，标题为：

Asterisk the Galling：使用 VBA InputBox() 输入密码

.

与往常一样，请注意代码中不需要的换行符。

于 2015-05-20T15:06:27.593 回答