LoginSignup
1
2

VBAでユーザーフォームのHWNDを取得する(WindowFromAccessibleObject)

Last updated at Posted at 2024-05-12

概要

VBAのユーザーフォームからHWND(ウィンドウハンドル)を取得する方法についてまとめた記事です。
HWNDを取得することで、他のWin32APIによりユーザーフォームの挙動を拡張することができるようになります。

動作確認環境

項目 バージョン
Windows 11 Pro 23H2
VBA 7.1.1136
VBAホスト Microsoft® Excel® for Microsoft 365 MSO (バージョン 2403 ビルド 16.0.17425.20176) 64 ビット/ 32 ビット

記事内で使用するWin32API

関数名 説明
WindowFromAccessibleObject ユーザーフォームからHWNDを取得するメイン関数です。以前はこれだけで問題無かったはずですが、動作確認環境では意図したように動作しないため以下の関数を追加で使用します。
GetClassNameW 取得したHWNDが意図したものかどうか判定するために使用します。
GetParent 取得したHWNDが意図したものではなかった場合に階層を移動するのに使用します。

VBA のコード

ユーザーフォームのHWNDを取得する
'ユーザーフォームなど IAccessible を実装するオブジェクトから HWND を取得する。
'https://learn.microsoft.com/ja-jp/windows/win32/api/oleacc/nf-oleacc-windowfromaccessibleobject
Private Declare PtrSafe _
    Function WindowFromAccessibleObject Lib "Oleacc.dll" ( _
        ByVal inIAccessible As Office.IAccessible, _
        ByRef phWnd As LongPtr _
    ) As Long 'HRESULT

'HWND のクラス名を取得する。
'https://learn.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-getclassnamew
Private Declare PtrSafe _
    Function GetClassNameW Lib "User32.dll" ( _
        ByVal hWnd As LongPtr, _
        ByVal lpClassName As LongPtr, _
        ByVal nMaxCount As Long _
    ) As Long 'Used Text Length

'HWND の親ウィンドウを取得する。
'https://learn.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-getparent
Private Declare PtrSafe _
    Function GetParent Lib "User32.dll" ( _
        ByVal hWnd As LongPtr _
    ) As LongPtr 'Parent HWND


Public Function GetUserFormHwndAsThunderDFrame( _
        ByVal inUserForm As Office.IAccessible _
    ) As LongPtr 'HWND
'ユーザーフォームから ThunderDFrame としての HWND を取得する。
'https://qiita.com/nukie_53/items/39c28d000d521329548b
'inUserForm :VBA の UserForm を指定する。 UserForm 内から呼び出す場合は Me を指定すればよい。
'           :Dim h As LongPtr
'           :h = GetUserFormHwndAsThunderDFrame(Me)
'return     :inUserForm の ThunderDFrame としての HWND を返す。意図したクラス名を取得できなかった場合はエラー。
240512
    Const ExpectClassName = "ThunderDFrame"
    If inUserForm Is Nothing Then Err.Raise 91
    
    'inUserForm から HWND を取得する。
    Dim hWnd1 As LongPtr
    Dim hr As Long 'HRESULT
    hr = WindowFromAccessibleObject(inUserForm, hWnd1)
    
    '成功した場合は S_OK 、失敗した場合はそれ以外の値となる。
    Const S_OK = 0
    If hr <> S_OK Then Err.Raise 5, , "ユーザーフォームのHWNDを取得できませんでした。"
    
    'HWND のクラス名を確認。
    
    '想定されるクラス名は長くても20文字程度。
    Dim classNameBuffer As String
    classNameBuffer = VBA.Strings.String(20, 0)
    
    'hWnd1 からクラス名を取得。
    Dim usedLen As Long
    usedLen = GetClassNameW(hWnd1, VBA.[_HiddenModule].StrPtr(classNameBuffer), VBA.Strings.Len(classNameBuffer))
    
    Dim className1 As String
    className1 = VBA.Strings.Left$(classNameBuffer, usedLen)
    
    If className1 = ExpectClassName Then
        '意図したクラス名なのでここで終了。
        Let GetUserFormHwndAsThunderDFrame = hWnd1
        Exit Function
    End If
    
    If className1 Like "F3 Server *" Then
        '365 環境?だと、"F3 Server eb8e0000"のようなクラス名になる。
        'この場合は、親の HWND をたどれば ThunderDFrame を取得できる。
        'Next
    Else
        Err.Raise 5, , "意図したクラス名のHWNDを取得できませんでした。" & vbLf & "HWND : " & hWnd1 & vbLf & "ClassName : " & className1
    End If
    
    '親の HWND を取得する。
    Dim hWnd2 As LongPtr
    hWnd2 = GetParent(hWnd1)
    
    'クラス名を確認。
    usedLen = GetClassNameW(hWnd2, VBA.[_HiddenModule].StrPtr(classNameBuffer), VBA.Strings.Len(classNameBuffer))
    
    Dim className2 As String
    className2 = VBA.Strings.Left$(classNameBuffer, usedLen)
    
    If className2 = ExpectClassName Then
        Let GetUserFormHwndAsThunderDFrame = hWnd2
        Exit Function
    End If
    
    Err.Raise 5, , "意図したクラス名のHWNDを取得できませんでした。" & vbLf & "HWND : " & hWnd2 & vbLf & "ClassName : " & className2
End Function

コードの解説

WindowFromAccessibleObject

    'inUserForm から HWND を取得する。
    Dim hWnd1 As LongPtr
    Dim hr As Long 'HRESULT
    hr = WindowFromAccessibleObject(inUserForm, hWnd1)
    
    '成功した場合は S_OK 、失敗した場合はそれ以外の値となる。
    Const S_OK = 0
    If hr <> S_OK Then Err.Raise 5, , "ユーザーフォームのHWNDを取得できませんでした。"

上記の箇所で、ユーザーフォーム自身を示す HWND を取得します。

WindowFromAccessibleObject
HRESULT WindowFromAccessibleObject(
  [in]  IAccessible *unnamedParam1,
  [out] HWND        *phwnd
);

WindowFromAccessibleObjectは上記のように定義されています。

IAccessible *unnamedParam1IAccessibleへのポインタを渡すということになりますが、VBAのIAccessibleはCOMオブジェクトであり、オブジェクト=参照型=変数にはポインタが入っている、となるため、ByValでIAccessibleを渡します。

HWND *phwndはHWNDへのポインタを渡すということになりますが、HWNDはVBAではLongPtrという値型で表現するため、そのままByRefでLongPtr変数を渡してあげます。
結果はHRESULTとなるため、0(=S_OK)であれば成功、それ以外であれば失敗となります。

'ユーザーフォームなど IAccessible を実装するオブジェクトから HWND を取得する。
'https://learn.microsoft.com/ja-jp/windows/win32/api/oleacc/nf-oleacc-windowfromaccessibleobject
Private Declare PtrSafe _
    Function WindowFromAccessibleObject Lib "Oleacc.dll" ( _
        ByVal inIAccessible As Office.IAccessible, _
        ByRef phWnd As LongPtr _
    ) As Long 'HRESULT

(参考)IAccessibleとは?

MSAA(Microsoft Active Accessibility)というアクセシビリティ関連技術で使われるインターフェイス(VBAにおける型のようなもの)です。

タイプライブラリMicrosoft Office 16.0 Object Libraryの非表示メンバーとして型の定義が公開されています。
後継技術であるUI AutomationのタイプライブラリUIAutomationClientでもIAccessibleの定義が公開されています(こちらでも非表示メンバーです)。

(参考)ほかの方法

FindWindow

FindWindowW関数を利用して、クラス名=ThunderDFrame、ウィンドウ名=フォームのCaptionとして検索するのも比較的メジャーな方法です。

この方法でも多くの場合は問題無く動作しますが、同名のユーザーフォームが複数存在する場合に意図しない挙動になりうるため注意が必要です。

同名のユーザーフォームが存在する状況としては、たまたま一致してしまう場合の他にMS Officeのアドインとしてフォームを表示している場合などが考えられます。

HWNDを取得する際に、一時的にフォームのCaptionを変更するなどの方法で対策はできますが、Captionを変更するとSetWindowLongなどで設定した内容が初期化されるなどの問題もあるため注意が必要です。

参考ページ

Microsoft 公式

その他

ここのコードを記載しているGitHub

自分のX

関連記事

1
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
2