0

WebページへのリンクがあるExcelワークブックがあります。ユーザーはリンクをクリックして、Excelウィンドウを最小化し、ブラウザーを開くことができます。サイトの操作が完了すると、ブラウザを最小化または閉じると、Excelに戻ります（以前のアクティブなウィンドウであったため）。

ユーザーがExcelに戻ったときに、VBAにアクション（テーブルの更新）を実行させたいのですが。

Workbook_WindowActivateイベントを見てきましたが、これは、Excelアプリケーション内で1つのExcelワークブックから別のExcelワークブックに移動する場合にのみ機能します。

どういうわけか、Application.nameまたはWindows関数GetActiveWindowを使用できるかもしれませんが、これを行う最善の方法がわかりません。

何か案は？ありがとう！

4

2 に答える 2

2

Workbook_SheetFollowHyperlink のイベント ハンドラーを追加します。その後、以下のコードを使用できます。これは、Web ページにフォーカスがあるかどうかを確認するだけです。「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
于 2013-02-01T00:42:07.833 に答える
0

これが私がやったことです。私はこの投稿からかなり借りました：Excelで定期的に実行されるマクロを作成するにはどうすればよいですか？

ユーザーがハイパーリンクをクリックすると、コードはExcelがアクティブウィンドウであるかどうかを定期的にチェックし始めます。GetActiveWindow関数は、ユーザーがExcelアプリケーションを使用していない場合はゼロを返し、使用している場合は正の数を返すことがわかりました。コードがユーザーが別のウィンドウからExcelに戻ったことを検出した場合（前のチェックでユーザーが別のウィンドウにあり、現在のチェックでExcelにあることが検出された場合）、テーブルが更新され、タイマーはアクティブなウィンドウのチェックを停止します。

このようにすることには、どのWebブラウザでも機能するという利点があります。

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
于 2013-02-04T22:25:48.453 に答える