none
AccessibleObjectFromWindow で Window オブジェクトを取得するときに対象の Excel インスタンスが特定の状態のときに動作が止まる RRS feed

  • 質問

  • タイトルが長くてわかりづらいですが以下のコード (Excel VBA) は複数の Excel インスタンスを
    起動しているときにすべての Excel インスタンスから特定のワークブックを開いているかを調べて
    開いていたらそのウィンドウをアクティブにする処理です。
    (ネット上の情報を組み合わせてあとは試行錯誤しながら自力で書きました)

    Option Explicit
    
    ' ShowWindow: ウィンドウの表示状態を変更する
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
    ' SetWindowPos
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    ' 直前にアクティブだったウィンドウを取得する
    Private Declare PtrSafe Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr
    ' AccessibleObjectFromWindow: ワークブックのウィンドウハンドルから Window オブジェクトを取得する
    Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
        ByVal hWnd As LongPtr, ByVal dwId As Long, _
        riid As Any, ppvObject As Any) As Long
    ' AccessibleObjectFromWindow: IID 文字列を IID に変換する
    Private Declare PtrSafe Function IIDFromString Lib "ole32" ( _
        ByVal lpsz As Any, lpiid As Any) As Long
    ' FindWindowEx: ウィンドウを探す
    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
    
    ' ウィンドウを非表示/表示/最小化などをするための定数 (ShowWindow 用)
    Private Const SW_HIDE               As Long = 0     ' ウィンドウを隠す
    Private Const SW_SHOWNORMAL         As Long = 1     ' ウィンドウを通常状態にする
    Private Const SW_SHOWMINIMIZED      As Long = 2     ' ウィンドウを最小化する
    Private Const SW_SHOWMAXIMIZED      As Long = 3     ' ウィンドウを最大化する
    Private Const SW_SHOW               As Long = 5     ' ウィンドウを表示する
    Private Const SW_MINIMIZE           As Long = 6     ' ウィンドウを最小化し、Z 順位が次のトップレベルウィンドウをアクティブにする
    Private Const SW_SHOWMINNOACTIVE    As Long = 7     ' ウィンドウを非アクティブで最小化する
    Private Const SW_SHOWNA             As Long = 8     ' ウィンドウを非アクティブで表示する
    Private Const SW_RESTORE            As Long = 9     ' ウィンドウをアクティブにし、最小化・最大化されている場合は元の位置とサイズに戻して表示する
    Private Const SW_SHOWDEFAULT        As Long = 10
    
    Private Const HWND_NOTOPMOST    As Long = -2
    Private Const HWND_TOPMOST      As Long = -1        ' 常に手前に表示
    Private Const HWND_TOP          As Long = 0         ' Z オーダーの先頭
    Private Const HWND_BOTTOM       As Long = 1         ' Z オーダーの最後
    Private Const SWP_NOACTIVATE    As Long = &H10      ' アクティブにしない
    Private Const SWP_SHOWWINDOW    As Long = &H40      ' Windowの表示
    Private Const SWP_HIDEWINDOW    As Long = &H80
    Private Const SWP_NOSIZE        As Long = &H1       ' サイズ変更しない
    Private Const SWP_NOMOVE        As Long = &H2       ' 移動しない
    Private Const SWP_NOZORDER      As Long = &H4
    
    ' GUID 構造体
    Private Type GUID
        lData1 As Long
        iData2 As Integer
        iData3 As Integer
        aBData4(0 To 7) As Byte
    End Type
    
    Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0
    Private Const IID_IDISPATCH As String = "{00020400-0000-0000-C000-000000000046}"
    
    Public Function MatchWorkbookActivate(ByVal Path As String, ByVal BookName As String) As Workbook
        Dim xlhWnd As LongPtr, hWnd As LongPtr
        Dim IDispatch As GUID
        Dim win As Object
        Dim xlApp As Application
        'Dim bCancel As Boolean, bNotify As Boolean
    
        ' Excel のウィンドウを探す
        xlhWnd = FindWindowEx(0, 0, "XLMAIN", vbNullString)
        ' すべての Excel ウィンドウを探しきるまでループ
        Do Until xlhWnd = 0
            hWnd = 0
            ' 開いているすべてのブックのウィンドウを探す (Excerl 2010 および Excel 2013 以降両対応)
            Set win = GetWindow2WindowObject(xlhWnd, hWnd)
            ' Excel 2010 では 1 つのインスタンスウィンドウ内に複数のブックウィンドウがあるのですべて探す
            ' Excel 2013 以降は 1 つのウィンドウごとに 1 つのブックウィンドウ
            Do Until win Is Nothing
                ' 通常のウィンドウである場合のみ
                If TypeName(win) = "Window" Then
                    Set xlApp = win.Application
                    ' ウィンドウを複製している場合を想定 & 大文字小文字が違う場合のための対策
                    If LCase(win.Parent.Name) = LCase(BookName) Then
                        ' 同じインスタンスかパスも含めて同名の場合にウィンドウをアクティブにする
                        If Application Is xlApp Or LCase(win.Parent.Path) = LCase(Path) Then
                            Set MatchWorkbookActivate = win.Parent
                            If win.Visible Then
                                If win.WindowState = xlMinimized Then
                                    'SetForegroundWindow xlhWnd
                                    'win.WindowState = xlNormal
                                    ShowWindow xlhWnd, SW_RESTORE
                                Else
                                    win.Activate
                                End If
                                SetWindowPos GetLastActivePopup(xlhWnd), HWND_TOP, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
                                Exit Do
                            End If
                        End If
                    End If
                End If
                ' 次の Excel ブックウィンドウを取得する
                Set win = GetWindow2WindowObject(xlhWnd, hWnd)
            Loop
            If Not MatchWorkbookActivate Is Nothing Then
                Exit Do
            End If
            ' 次の Excel ウィンドウを取得する
            xlhWnd = FindWindowEx(0, xlhWnd, "XLMAIN", vbNullString)
        Loop
    End Function
    
    ' ウィンドウハンドルからワークブックの Window オブジェクトを取得する
    Public Function GetWindow2WindowObject(Optional ByVal hWnd As LongPtr = 0, Optional ByRef hPrevWnd As LongPtr = 0) As Object
        Dim IDispatch As GUID
        Dim hXL7Wnd As LongPtr
    
        hPrevWnd = FindWindowEx(FindWindowEx(hWnd, 0&, "XLDESK", vbNullString), hPrevWnd, "EXCEL7", vbNullString)
    
        If hPrevWnd Then
            IIDFromString StrPtr(IID_IDISPATCH), IDispatch
            AccessibleObjectFromWindow hPrevWnd, OBJID_NATIVEOM, IDispatch, GetWindow2WindowObject
        End If
    End Function
    
    Sub test()
        MatchWorkbookActivate "<ワークブックのパス>", "<ワークブックの名前>"
    End Sub

    この処理を実行しているときに FileDialog やセキュリティに関する通知ダイアログボックスなどが
    表示されているインスタンスがあるとそのインスタンスを取得する AccessibleObjectFromWindow の
    ところで先述のダイアログが閉じられるまで動作が止まってしまいます。
    これを回避する方法はありませんか?

    意味が分かりにくかったら申し訳ありません。


    • 編集済み infade 2019年6月24日 5:19 誤字修正 & 微追記
    2019年6月24日 4:58

すべての返信

  • infadeさん こんにちは、
    >この処理を実行しているときに FileDialog やセキュリティに関する通知ダイアログボックスなどが
    >表示されているインスタンスがあるとそのインスタンスを取得する AccessibleObjectFromWindow の
    >ところで先述のダイアログが閉じられるまで動作が止まってしまいます。
    xlhWnd = FindWindowEx(0, 0, "XLMAIN", vbNullString)とありますので、
    ExcelのFileDialog やセキュリティに関する通知ダイアログボックスなどだと思うのですが、
    うまく再現ができません。
    FileDialog やセキュリティに関する通知ダイアログボックスなどが他のBookで出されている場合、
    マクロを実行できません。また、自身のBookでFileDialog等を表示した場合、入力待ちUIで中断してしまいます。
    あくまで、確認しているExcel2013の為かも知れませんが。
    実行の目的に問題をきたさないなら、閉じてしまうと言うのは、過激ですよね。
        If hPrevWnd Then
        SendKeys "{ESC}"
            IIDFromString StrPtr(IID_IDISPATCH), IDispatch
            AccessibleObjectFromWindow hPrevWnd, OBJID_NATIVEOM, IDispatch, GetWindow2WindowObject
        End If

    追記:再現出来ました。上の掲載文は、とんだ勘違いで全く的を得ていませんでした。申し訳ございません。
    また、対象がアクティブでない SendKeys "{ESC}"など意味がありませんでした。
    再現方法は、WordのVBEを使用して必要となる参照設定を行い、Dim xlApp  ’As Application(コメントアウト)
    実行。エラーではなく中断します。(しばらくすると実行行が変わっていきますが、変な挙動)

    • 編集済み Takumi_Q 2019年6月25日 13:41 検証し、発言を撤回します。
    2019年6月25日 7:17