Question

我想我有一个相当简单的问题。我正在寻找一种方法来获取excel输入框的hwnd。我自动化了一个流程，并且我注意到一个类型8输入框始终位于excel窗口下面（如果有帮助的话，我可以自动从另一个应用程序中获取excel）。显然，我希望它显示在顶部，并且我尝试使用SetForegroundWindow函数。有什么建议吗？

根据要求，我发现的唯一值得尝试的事情是：

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

Answer 1

这不是一个简单的问题 - 答案可以解决VBA中几个令人沮丧的差距。

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

当＆＃39;模态＆＃39; state被释放，允许VBA再次运行命令和API函数，InputBox已经消失。

幸运的是，2003年10月，manish1239＆＃39;发现了一种解决方法，他在Xtreme Visual Basic Talk上发布了一个巧妙的黑客攻击：他把你需要的代码放在一个VBA函数中运行等待状态，使用来自API计时器的延迟回调。

我用他的代码设置了密码查询器＆＃39;在VBA InputBox中：它是一个需要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

' Replicates the functionality of a VBA InputBox function, with the user's ' typed input displayed as asterisks. The 'Title' parameter for the dialog ' caption is hardcoded as "Password Required" in this implementation.

' REQUIRED function: TimerProcInputBox ' REQUIRED API declarations: FindWindow, FindWindowEx, SetTimer, KillTimer

' Nigel Heffernan, January 2015,

' **** **** **** *** THIS CODE IS IN THE PUBLIC DOMAIN **** **** **** ****

' Based on code posted by user 'manish1239' in Xtreme Visual Basic Talk in ' October 2003 http://www.xtremevbtalk.com/archive/index.php/t-112708.html

' Coding notes: we send the 'Set PasswordChar' message to the textbox edit ' window in the VBA 'InputBox' dialog. This isn't a straightforward task: ' InputBox is synchronous, a 'Modal Dialog' which leaves our application's ' VBA code in a waiting state at the exact moment we need to call the Send ' Message API function. So it runs by a delayed callback from an API Timer

' Warning: many of the 64-bit API declarations posted online are incorrect ' and none of them are correct for the pointer-safe Timer API Functions.

On Error Resume Next

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

InputBoxPassword = InputBox(Prompt, _ PASSBOX_INPUT_CAPTION, _ Default, _ XPos, YPos, _ HelpFile, HelpContext)

End Function

#If VBA7 And Win64 Then ' 64 bit Excel under 64-bit windows ' Use LongLong and LongPtr ' Note that wMsg is always the WM_TIMER message, which fits in a Long Public Sub TimerProcInputBox(ByVal hwnd As LongPtr, _ ByVal wMsg As Long, _ ByVal idEvent As LongPtr, _ ByVal dwTime As LongLong) On Error Resume Next

' 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 ' Use LongPtr only

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 bit 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

您需要以下声明：

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

我在我的博客Excellerando上发布了这个标题：

Asterisk the Galling: Using The VBA InputBox() For Passwords

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

获取Excel输入框方法的hwnd

1 个答案:

Asterisk the Galling: Using The VBA InputBox() For Passwords