如果用户从其他应用程序返回到Excel,请执行操作

我有一个Excel工作簿,链接到一个网页。 用户可以点击链接,最小化Excel窗口并打开浏览器。 当他们完成了网站,他们最小化或closures他们的浏览器,它们返回到Excel(因为这是他们以前的活动窗口)。

我希望VBA在用户返回到Excel时执行一个操作(更新表)。

我已经看了Workbook_WindowActivate事件,但这只适用于在Excel应用程序中从一个Excel工作簿移动到另一个Excel工作簿的情况。

也许我可以使用Application.name或Windows函数GetActiveWindow不知何故,但我不知道如何最好的做到这一点。

有任何想法吗? 谢谢!

您想为Workbook_SheetFollowHyperlink添加一个事件处理程序。 然后你可以使用下面的代码。 这只是检查,看网页是否有焦点。 'DO EVENTS'就是你要添加你的代码然后退出的地方

'********************* References used '* Microsoft Shell Controls An Automation : shell32.dll* '* Microsoft HTML Objects Library: MSHTML.dll expand » * '* Microsoft Internet Controls: IEFRAME.dll * Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) Dim ie As InternetExplorer 'IE window variable Dim sUrl 'url of the webpage Dim dt As Date 'timer 'set the url to look for sUrl = Target.Address 'set initial timeout period *used instead of browser ready due to page redirection. 'you should also check the browser ready status dt = DateAdd("s", 5, DateTime.Now) Do While dt > DateTime.Now DoEvents Loop 'reset the timeout period to allow time to view and select dt = DateAdd("s", 30, DateTime.Now) Dim shShell As New Shell ' windows shell variable 'continue loop until we hit the timeout or the webpage no longer has focus Do While dt > DateTime.Now 'Loop through all the IE windows For Each ie In shShell.Windows 'check to see if the URL's match If InStr(ie.LocationURL, sUrl) Then Dim hDoc As HTMLDocument 'get the webpage document Set hDoc = ie.document 'check to see if it has focus If Not hDoc.hasFocus Then ThisWorkbook.Activate ''''''''''''' ' DO EVENTS ' ''''''''''''' Exit Sub End If Set hDoc = Nothing End If Next ie Loop End Sub 

这是我最终做的。 我从这篇文章中借了很多: 如何制作一个在Excel中定期执行的macros?

当用户点击超链接时,代码开始定期检查Excel是否是其活动窗口。 我发现,GetActiveWindow函数返回零,如果用户不在Excel应用程序和一些正数,如果他们是。 如果代码发现用户从一个不同的窗口返回Excel(以前的检查发现他们在不同的窗口中,而当前的人发现他们在Excel中),那么我的表得到更新,计时器停止检查活动窗口。

这样做的优点是适用于任何网页浏览器。

 Option Explicit Dim ExcelIsActive As Boolean Private Declare Function GetActiveWindow Lib "user32" () As Long Dim m_dtNextTime As Date Dim m_dtInterval As Date Dim DisableFlag As Boolean Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) Call start End Sub Public Sub Enable(Interval As Date) Call Disable m_dtInterval = Interval Call starttimer End Sub Private Sub starttimer() m_dtNextTime = Now + m_dtInterval Application.OnTime m_dtNextTime, "TestActive" End Sub Public Sub TestActive() If GetActiveWindow > 0 Then If ExcelIsActive = False Then ExcelIsActive = True Call RefreshQuery End If Else ExcelIsActive = False End If If Not DisableFlag Then Call starttimer Else Call Disable End If End Sub Public Sub Disable() Dim dtZero As Date If m_dtNextTime <> dtZero Then ' Stop timer if it is running On Error Resume Next Application.OnTime m_dtNextTime, "TestActive", , False On Error GoTo 0 m_dtNextTime = dtZero End If m_dtInterval = dtZero End Sub Sub start() 'Start the timer DisableFlag = False ExcelIsActive = True 'Sets the interval to be three seconds Call Enable(#12:00:03 AM#) End Sub Public Sub RefreshQuery() 'I do my stuff here 'Stop the timer until the next time the user launches the browser DisableFlag = True End Sub