无需单击即可将焦点置于无模式用户窗体 (Excel 2010 VBA)
Bring Focus to Modeless Userform without Clicking (Excel 2010 VBA)
我正在开始编写一个项目,该项目将打开、登录并从 Internet Explorer 文档中检索值。该过程将 Excel 电子表格中的值粘贴到专有的汽车 VIN 解码站点,从生成的页面中抓取数据,然后将这些值写入电子表格。
该程序运行良好。由于该页面有时 return 出错,我设计了一个 Excel 用户窗体,在处理之前调用它来询问工作表的哪一行首先开始处理。使用以下代码调用表单:
Load frmStartRow
With frmStartRow 'Load start row form and await response
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
sndPlaySound32 "C:\Windows\Media\chimes.wav", 1&
.Show vbModeless
End With
调用表单按预期工作,但有一个非常关键的异常。因为IE浏览器在窗体激活时有焦点,窗体出现但必须点击才能进入焦点。该表单包含一个文本框来接受行号,我希望该表单显示在其他表单之上 windows,是模态的并且能够接受数据而无需用户单击它。
我已经尝试使用 API 将 window 置于顶部,玩弄 vbModal 与 vb Modelss(如图所示),尝试将焦点切换到用户窗体在窗体的 Activate 事件和其他方法均未成功。我可以让表格显示在顶部,但它仍然 必须先单击才能接受数据。
现在设置代码的方式是我最接近的。对于 vbModal 用户窗体,我无法将其显示在顶部,这比必须单击它更糟糕。我确实找到了对 .PopUp 方法或 属性 的引用,这似乎是个窍门,但它似乎不是 Excel 2010 的选项。
归根结底,我正在尝试实现一个弹出模式用户窗体,该用户窗体在激活后立即可以输入数据,而无需单击即可将焦点置于窗体上。感谢您的帮助!
用于调用 IE 的代码:
Dim objIEVIN
Set objIEVIN = New InternetExplorerMedium
With objIEVIN
.Visible = True
.Navigate "http://www.fleet.ford.com/maintenance/vin-decoder/"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop 'Wait for page loading to complete
End With
Siddharth Rout 的评论让我思考了 IE 对象在这个问题中的作用。如果我最初设置 IE 对象的 .Visible = False,然后调用用户窗体并在用户窗体关闭后设置 .Visible = True,则用户窗体的行为符合预期。
我正在使用双显示器,并且昨天阅读了有关此类设置的问题。如果我在同一屏幕上 运行 Excel 和 IE,我会得到相同的结果。当我 运行 从我的笔记本电脑(单显示器)应用程序时,我也得到了相同的结果。我想提一下,因为它可能与问题有关。
您可以在显示表格之前使用AppActivate
,例如:
VBA.AppActivate(thisworkbook.Windows(1).Caption)
How would I send the IE object to the back? – spacetanker 7 mins ago
最简单的方法是将其最小化,否则您将不得不使用其他 API (SetWindowPos
) 将其发回。试试这个
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWMINIMIZED = 2
Sub Sample()
Dim ie As Object
Set ie = CreateObject("internetExplorer.Application")
ie.Visible = True
apiShowWindow ie.hwnd, SW_SHOWMINIMIZED
End Sub
为了 return 焦点,您可以在最小化 window 后尝试类似 TextBox1.SetFocus
的方法。
SetForegroundWindow
和 SendKeys
的组合似乎有效:
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Boolean
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Sub Example()
Dim objIEVIN
Set objIEVIN = New InternetExplorerMedium
With objIEVIN
.Visible = True
.navigate "www.google.com"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
End With
Dim hWnd As Long
UserForm1.Show vbModeless
hWnd = FindWindow("ThunderDFrame", UserForm1.Caption)
SetForegroundWindow hWnd
SendKeys vbTab
End Sub
编辑: 上面的代码似乎只有在没有任何键盘输入指向 IE window 时才有效。由于 IE 不是一个拥有的进程(见评论),一种替代方法是在 window:
的标题栏上模拟 mouse-click
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Boolean
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Sub Example()
Dim objIEVIN
Set objIEVIN = New InternetExplorerMedium
With objIEVIN
.Visible = True
.navigate "www.google.com"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
End With
Dim hwnd As Long
UserForm1.Show vbModeless
hwnd = FindWindow("ThunderDFrame", UserForm1.Caption)
SetForegroundWindow hwnd
Dim pos As RECT
GetWindowRect hwnd, pos
SetCursorPos pos.Left + 1, pos.Top + 1
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
请注意,这基本上是作为概念证明 - 对于生产实施,您可能希望在 API 调用周围添加一堆错误处理(我会亲自缓存和重置鼠标位置)。
在花了一天时间尝试不同的方法来解决问题后,我的代码因来自不同来源的代码而变得臃肿。在尝试共产国际和 Siddharth Rout 共享的技术但没有成功时,我清理了所有此类残余的代码,保存并重新打开了表单。
在我开始尝试解决问题之前,我发誓代码和表单的每个细节都与它们的状态相同。也就是说,清理以某种方式使焦点问题正常工作。
我将 Solve 授予共产国际,感谢他的工作流程建议,但以上是我尝试过的各种事情的简要概要,因此所有相关人员都得到 "Honorable Mention" 并感谢他们的时间和考虑。
我正在开始编写一个项目,该项目将打开、登录并从 Internet Explorer 文档中检索值。该过程将 Excel 电子表格中的值粘贴到专有的汽车 VIN 解码站点,从生成的页面中抓取数据,然后将这些值写入电子表格。
该程序运行良好。由于该页面有时 return 出错,我设计了一个 Excel 用户窗体,在处理之前调用它来询问工作表的哪一行首先开始处理。使用以下代码调用表单:
Load frmStartRow
With frmStartRow 'Load start row form and await response
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
sndPlaySound32 "C:\Windows\Media\chimes.wav", 1&
.Show vbModeless
End With
调用表单按预期工作,但有一个非常关键的异常。因为IE浏览器在窗体激活时有焦点,窗体出现但必须点击才能进入焦点。该表单包含一个文本框来接受行号,我希望该表单显示在其他表单之上 windows,是模态的并且能够接受数据而无需用户单击它。
我已经尝试使用 API 将 window 置于顶部,玩弄 vbModal 与 vb Modelss(如图所示),尝试将焦点切换到用户窗体在窗体的 Activate 事件和其他方法均未成功。我可以让表格显示在顶部,但它仍然 必须先单击才能接受数据。
现在设置代码的方式是我最接近的。对于 vbModal 用户窗体,我无法将其显示在顶部,这比必须单击它更糟糕。我确实找到了对 .PopUp 方法或 属性 的引用,这似乎是个窍门,但它似乎不是 Excel 2010 的选项。
归根结底,我正在尝试实现一个弹出模式用户窗体,该用户窗体在激活后立即可以输入数据,而无需单击即可将焦点置于窗体上。感谢您的帮助!
用于调用 IE 的代码:
Dim objIEVIN
Set objIEVIN = New InternetExplorerMedium
With objIEVIN
.Visible = True
.Navigate "http://www.fleet.ford.com/maintenance/vin-decoder/"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop 'Wait for page loading to complete
End With
Siddharth Rout 的评论让我思考了 IE 对象在这个问题中的作用。如果我最初设置 IE 对象的 .Visible = False,然后调用用户窗体并在用户窗体关闭后设置 .Visible = True,则用户窗体的行为符合预期。
我正在使用双显示器,并且昨天阅读了有关此类设置的问题。如果我在同一屏幕上 运行 Excel 和 IE,我会得到相同的结果。当我 运行 从我的笔记本电脑(单显示器)应用程序时,我也得到了相同的结果。我想提一下,因为它可能与问题有关。
您可以在显示表格之前使用AppActivate
,例如:
VBA.AppActivate(thisworkbook.Windows(1).Caption)
How would I send the IE object to the back? – spacetanker 7 mins ago
最简单的方法是将其最小化,否则您将不得不使用其他 API (SetWindowPos
) 将其发回。试试这个
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWMINIMIZED = 2
Sub Sample()
Dim ie As Object
Set ie = CreateObject("internetExplorer.Application")
ie.Visible = True
apiShowWindow ie.hwnd, SW_SHOWMINIMIZED
End Sub
为了 return 焦点,您可以在最小化 window 后尝试类似 TextBox1.SetFocus
的方法。
SetForegroundWindow
和 SendKeys
的组合似乎有效:
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Boolean
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Sub Example()
Dim objIEVIN
Set objIEVIN = New InternetExplorerMedium
With objIEVIN
.Visible = True
.navigate "www.google.com"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
End With
Dim hWnd As Long
UserForm1.Show vbModeless
hWnd = FindWindow("ThunderDFrame", UserForm1.Caption)
SetForegroundWindow hWnd
SendKeys vbTab
End Sub
编辑: 上面的代码似乎只有在没有任何键盘输入指向 IE window 时才有效。由于 IE 不是一个拥有的进程(见评论),一种替代方法是在 window:
的标题栏上模拟 mouse-clickConst MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Boolean
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Sub Example()
Dim objIEVIN
Set objIEVIN = New InternetExplorerMedium
With objIEVIN
.Visible = True
.navigate "www.google.com"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
End With
Dim hwnd As Long
UserForm1.Show vbModeless
hwnd = FindWindow("ThunderDFrame", UserForm1.Caption)
SetForegroundWindow hwnd
Dim pos As RECT
GetWindowRect hwnd, pos
SetCursorPos pos.Left + 1, pos.Top + 1
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
请注意,这基本上是作为概念证明 - 对于生产实施,您可能希望在 API 调用周围添加一堆错误处理(我会亲自缓存和重置鼠标位置)。
在花了一天时间尝试不同的方法来解决问题后,我的代码因来自不同来源的代码而变得臃肿。在尝试共产国际和 Siddharth Rout 共享的技术但没有成功时,我清理了所有此类残余的代码,保存并重新打开了表单。
在我开始尝试解决问题之前,我发誓代码和表单的每个细节都与它们的状态相同。也就是说,清理以某种方式使焦点问题正常工作。
我将 Solve 授予共产国际,感谢他的工作流程建议,但以上是我尝试过的各种事情的简要概要,因此所有相关人员都得到 "Honorable Mention" 并感谢他们的时间和考虑。