获取Excel InputBox方法的hwnd [英] Get hwnd of Excel InputBox Method

问题描述

我想我有一个相当简单的问题。我正在寻找一个方法来获取hwnd的excel输入框。我自动化一个进程，我注意到一个类型8输入框一直在excel窗口下面（如果这是有帮助的话，我自动从另一个应用程序的excel）。显然，我希望它显示在顶部，我试图使用SetForegroundWindow函数。任何建议？

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

 公共函数GetHwnd（）为Long 
 GetHwnd = Excel.Application.InputBox.hwnd 
结束函数
  

解决方案

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

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

当modal状态被释放时，VBA可以再次运行命令和API函数，InputBox已经消失了。幸运的是，2003年10月，manish1239发现了一个解决方法，他在 Xtreme Visual Basic Talk ：他把你需要运行的代码放在一个运行在等待状态的VBA函数中，使用延迟回调从API定时器。

我使用他的代码在VBA InputBox中设置PasswordChars：它是一个需要InputBox窗口句柄的API调用，您可以调整
$ b pre
公共功能InputBoxPassword（提示为String，_
可选缺省为String = vbNullString，_
可选XPos，可选YPos，_
可选HelpFile，可选HelpContext _
）As String
On Error Resume Next

'复制功能VBA InputBox功能，用户的
'键入输入显示为星号。
'caption对话框的'Title'参数在此实现中被硬编码为Password Required。

'REQUIRED函数：TimerProcInputBox
'必需的API声明：FindWindow，FindWindowEx，SetTimer，KillTimer

'Nigel Heffernan，2015年1月，

'* *** **** **** ***这个代码是在公共领域**** **** **** ****

'根据用户'manish1239'在Xtreme Visual Basic Talk中发布的代码
'2003年10月 http://www.xtremevbtalk.com/archive/index.php/t-112708.html

'编码注意：我们将Set PasswordChar消息发送到VBAInputBox对话框中的文本框编辑
'窗口。这不是一个简单的任务：
'InputBox是同步的，一个'模态对话框'，使我们的应用程序的
'VBA代码处于等待状态，在我们需要调用发送
'Message API函数。所以它通过API定时器的延迟回调运行$ / $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $没有对于指针安全的Timer API函数是正确的。

On Error Resume Next

SetTimer 0& 0& 10& amp; AddressOf TimerProcInputBox

InputBoxPassword = InputBox（Prompt，_
PASSBOX_INPUT_CAPTION，_
默认值，_
XPos，YPos，_
HelpFile，HelpContext）

结束功能

如果VBA7和Win64然后'64位Excel 64位窗口'使用LongLong和LongPtr
'请注意，wMsg始终是WM_TIMER消息，它适合Long
公共Sub TimerProcInputBox（ByVal hwnd As LongPtr ，_
ByVal wMsg As Long，_
ByVal idEvent As LongPtr，_
ByVal dwTime As LongLong）
On Error Resume Next

 '需要为函数InputBoxPassword 
'https://msdn.microsoft.com/en-US/library/windows/desktop/ms644907(v=vs.85).aspx 
 
 KillTimer hWndIbox，idEvent 
 
 Dim hWndIbox As LongPtr'处理到VBA InputBox 
 
 hWndIbox = FindWindowEx（FindWindow（＃32770，PASSBOX_INPUT_CAPTION），0，Edit，）
 
如果hWndIbox<> 0然后
 SendMessage hWndIbox，EM_SETPASSWORDCHAR，Asc（*），0& 
 End If 
 
 End Sub 
  

#ElseIf VBA7然后' 32位Office中的VBA7仅使用LongPtr

 公共Sub TimerProcInputBox（ByVal hwnd As LongPtr，_ 
 ByVal wMsg As Long，_ 
 ByVal idEvent As LongPtr，_ 
 ByVal dwTime As Long）
 On Error Resume Next 
 
'需要功能InputBoxPassword 
'https ：//msdn.microsoft.com/en-US/library/windows/desktop/ms644907（v = vs85）.aspx 
 
 Dim hWndIbox As LongPtr'处理到VBA InputBox 
 
 KillTimer hwnd，idEvent 
 
 hWndIbox = FindWindowEx（FindWindow（＃32770，PASSBOX_INPUT_CAPTION），0，编辑，）
 
 
如果hWndIbox<> 0然后
 SendMessage hWndIbox，EM_SETPASSWORDCHAR，Asc（*），0& 
如果
 
 
 End Sub 
  

＃其他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 
 
'需要功能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，）
 
如果hWndIbox& 0然后
 SendMessage hWndIbox，EM_SETPASSWORDCHAR，Asc（*），0& 
如果
 
 
 End Sub 
  

＃结束如果

您需要以下声明：

 
选项显式
选项私人模块
 
 
 
＃如果VBA7和Win64然后' 64位Excel 64位窗口'使用LongLong和LongPtr 
 私有声明PtrSafe函数FindWindowEx Libuser32别名FindWindowExA _ 
（ByVal hWnd1 As LongPtr，_ 
 ByVal hWnd2 As LongPtr，_ 
 ByVal lpsz1 As String，_ 
 ByVal lpsz2 As String _ 
）As LongPtr 
私有声明PtrSafe函数FindWindow Libuser32别名FindWindowA_ 
（ByVal lpClassName As String，_ 
 ByVal lpWindowName As String）As LongPtr 
私有声明PtrSafe函数SendMessage Libuser32别名SendMessageA_ 
（ByVal hwnd As LongPtr，_ 
 ByVal wMsg As Long，_ 
 ByVal wParam As Long，_ 
 ByRef lParam As Any _ 
）As LongPtr 
私有声明PtrSafe函数SetTimer Libuser32_ 
（ByVal hwnd As LongPtr，_ 
 ByVal nIDEvent As LongPtr，_ 
 ByVal uElapse As Long，_ 
 ByVal lpTimerFunc As LongPtr _ 
）As Long 
公开声明PtrSafe函数KillTimer Libuser32_ 
（ByVal hwnd As LongPtr，_ 
 ByVal nIDEvent As LongPtr _ 
）As Long 
  
 #ElseIf VBA7然后32位Office中的VBA7仅使用LongPtr，LongLong不可用
 私有声明PtrSafe函数FindWindowEx Libuser32别名FindWindowExA_ 
（ByVal hWnd1 As LongPtr，_ 
 ByVal hWnd2 As LongPtr，_ 
 ByVal lpsz1 As String，_ 
 ByVal lpsz2 As String _ 
）As LongPtr 
私有声明PtrSafe函数FindWindow Libuser32别名FindWindowA_ 
（ByVal lpClassName As String，_ 
 ByVal lpWindowName As String）As LongPtr 
私有声明PtrSafe函数SendMessage Libuser32别名SendMessageA_ 
（ByVal hwnd As LongPtr，_ 
 ByVal wMsg As Long，_ 
 ByVal wParam As Long，_ 
 ByRef lParam As Any _ 
）As LongPtr 
私有声明PtrSafe函数SetTimer Libuser32_ 
（ByVal hwnd As LongPtr，_ 
 ByVal nIDEvent As Long，_ 
 ByVal uElapse As Long，_ 
 ByVal lpTimerFunc As LongPtr）As LongPtr 
私有声明PtrSafe函数KillTimer Libuser32_ 
（ByVal hwnd As LongPtr，_ 
 ByVal nIDEvent As Long）As Long 
  
 #Else'32位Excel 
 私有声明函数FindWindowEx Libuser32别名FindWindowExA_ 
（ByVal hWnd1 As Long，_ 
 ByVal hWnd2 As Long，_ 
 ByVal lpsz1 As String，_ 
 ByVal lpsz2 As String _ 
）As Long 
私有声明函数FindWindow Libuser32别名FindWindowA_ 
（ByVal lpClassName As String，_ 
 ByVal lpWindowName As String）As Long 
私有声明函数SendMessage Libuser32别名SendMessageA_ 
（ByVal hwnd As Long，_ 
 ByVal wMsg As Long，_ 
 ByVal wParam As Long，_ 
 ByRef lParam As Any _ 
）As Long 
私有声明函数SetTimer Libuser32_ 
（ByVal hwnd As Long，_ 
 ByVal nIDEvent As Long，_ 
 ByVal uElapse As Long，_ 
 ByVal lpTimerFunc As Long）As Long 
公共声明函数KillTimer Libuser32_ 
（ByVal h wnd As Long，_ 
 ByVal nIDEvent As Long）As Long 
  
 #End If 
 
 
 
 Private Const PASSBOX_INPUT_CAPTION As String =Password Required
 Private Const EM_SETPASSWORDCHAR As Long =& HCC 
 Private Const NV_INPUTBOX As Long =& H5000& 
 

我发布在我的博客Excellerando的标题下：

星号加仑：使用VBA InputBox（）对于密码

。

一如往常，请注意代码中不必要的换行符。

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

解决方案

It's not so simple a question - and the answer works around several frustrating gaps in VBA.

The VBA.InputBox function creates a 'Modal Dialog' which leaves your application's VBA code in a waiting state at the exact moment you needed VBA to grab the Window Handle and call some or other API function.

By the time the 'modal' state is released, allowing VBA to run commands and API functions again, the InputBox has gone away.

Fortunately, a workaround was discovered in October 2003 by 'manish1239', who posted an ingenious hack on Xtreme Visual Basic Talk: he put the code you need to run in a VBA function that runs around that waiting state, using a delayed callback from an API Timer.

I used his code to set 'PasswordChars' in a VBA InputBox: it's an API call that needs the InputBox window handle, and you can adapt the code for your needs

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

You'll need the following declarations:

Option Explicit
Option Private Module


#If VBA7 And Win64 Then    ' 64 bit Excel under 64-bit windows   ' Use LongLong and 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  ' Use LongPtr only, LongLong is not available
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 bit 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
#End If

Private Const PASSBOX_INPUT_CAPTION As String = "Password Required"
Private Const EM_SETPASSWORDCHAR    As Long = &HCC
Private Const NV_INPUTBOX           As Long = &H5000&

I posted this up on my blog, Excellerando, under the heading:

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

.

As always,watch out for unwanted line breaks in the code.

这篇关于获取Excel InputBox方法的hwnd的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！