无需点击即可将焦点转移到无模式用户表格(Excel 2010 VBA)

时间:2016-09-23 12:37:40

标签: excel vba excel-vba excel-2010 userform

我开始编写一个项目,该项目将打开,登录并从Internet Explorer文档中检索值。该过程将Excel电子表格中的值粘贴到专有的汽车VIN解码站点,对结果页面进行数据擦除,然后将这些值写入电子表格。

该程序运作良好。由于页面有时会返回错误,因此我设计了一个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浏览器在激活表单时具有焦点,所以表单出现但必须单击 才能成为焦点。表单包含一个文本框以接受行号,我希望表单显示在其他窗口的顶部,是模态的,并且能够接受数据而无需用户点击它。

我已经尝试过API将窗口置于顶端,玩弄vbModal与vb Modelss(如图所示),试图将焦点切换到表单的Activate事件中的userform和其他方法,但没有成功。我可以让表单显示在顶部,但在接受数据之前仍然必须单击

现在设置代码的方式是我最接近的。使用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,然后调用userform并在userform关闭后设置.Visible = True,则userform按预期运行。

我正在使用双显示器,并在昨天阅读有关此类设置的问题。如果我在同一个屏幕上同时运行Excel和IE,我会得到相同的结果。当我从笔记本电脑(单显示器)运行应用程序时,我也得到相同的结果。我想提一下,因为它可能涉及到这个问题。

4 个答案:

答案 0 :(得分:1)

  

我如何将IE对象发送到后面? - spacetanker 7分钟前

最简单的方法是最小化它,否则你将不得不使用其他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

要返回焦点,您可以在最小化窗口后尝试TextBox1.SetFocus之类的内容。

答案 1 :(得分:0)

您可以在显示表单之前使用AppActivate ,例如:

VBA.AppActivate(thisworkbook.Windows(1).Caption)

答案 2 :(得分:0)

SetForegroundWindowSendKeys的组合似乎有效:

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窗口,上面的代码似乎只能工作。由于IE不是一个拥有的进程(请参阅注释),另一种方法是在窗口的标题栏上模拟鼠标单击:

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调用添加一堆错误处理(我个人缓存并重置鼠标位置)。 / p>

答案 3 :(得分:0)

在花了一天时间尝试不同的方法来解决问题之后,我的代码被来自不同来源的一些代码臃肿了。在尝试Comintern和Siddharth Rout共享的技术时没有成功,我清理了所有这些遗留物的代码,保存并重新打开了表格。

在我开始尝试解决问题之前,我会发誓代码和表单在每个细节上都是相同的。也就是说,以某种方式进行清理会使焦点问题得以实现。

我正在向共产国际提出解决方案,因为他的工作流建议,但上面是我所尝试过的各种事情的简要概要,因此所有参与者都获得了“荣誉奖”并感谢他们的时间和考虑。