トップ　>　備忘録　>　ウィンドウのハンドル・クラス名一覧を作成する

' ***（宣言セクションに記述）***
'-------------------------------------
' Win32API
'-------------------------------------
'《マウス カーソルの位置を画面座標で取得》
' https://learn.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-getcursorpos
Declare PtrSafe Function GetCursorPos Lib "user32" ( _
                                        ByRef lpPoint As POINTAPI) As Long

'《指定したウィンドウの親または所有者へのハンドルを取得》
' https://learn.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-getparent
Declare PtrSafe Function GetParent Lib "user32" ( _
                                        ByVal hwnd As LongPtr) As Long
   
'《親のウィンドウハンドルを基にクラス名やウィンドウ名に一致する子のウィンドウハンドルを取得》
' https://learn.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-findwindowexw
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
                                        ByVal hwndParent As LongPtr, _
                                        ByVal hwndChildAfter As LongPtr, _
                                        ByVal lpClassName As String, _
                                        ByVal lpWindowName As String) As LongPtr
                                        
'《指定したウィンドウと関連するウィンドウへのハンドルを取得》
' https://learn.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-getwindow
Declare PtrSafe Function GetWindow Lib "user32" ( _
                                        ByVal hwnd As LongPtr, _
                                        ByVal uCmd As Long) As LongPtr

'《指定したポイントを含むウィンドウのハンドルを取得》
' https://learn.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-windowfrompoint
Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                        ByVal x As Long, _
                                        ByVal y As Long) As LongPtr

'《指定したウィンドウが属するクラスの名前を取得》
' https://learn.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-getclassname
Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
                                        ByVal hwnd As LongPtr, _
                                        ByVal lpClassName As String, _
                                        ByVal nMaxCount As LongPtr) As Long
                               
'《指定したウィンドウのテキストを取得》
' https://learn.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-getwindowtexta
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
                                        ByVal hwnd As LongPtr, _
                                        ByVal lpString As String, _
                                        ByVal nMaxCount As Long) As Long

'-------------------------------------
' 構造体
'-------------------------------------
' GetCursorPos 関数 の引数として使用
Type POINTAPI
   x As Long
   y As Long
End Type

'-------------------------------------
' 定数
'-------------------------------------
' GetWindowの 引数2 uCmd に指定するパラメーター
Const GW_HWNDFIRST As Long = 0  ' 基準となるWindowと同じ種類のうち最前面のWindow
Const GW_HWNDLAST  As Long = 1  ' 基準となるWindowと同じ種類のうち最背面のWindow
Const GW_HWNDNEXT  As Long = 2  ' 基準となるWindowの次のWindow
Const GW_HWNDPREV  As Long = 3  ' 基準となるWindowの前のWindow
Const GW_OWNER     As Long = 4  ' 基準となるWindowのオーナーWindow
Const GW_CHILD     As Long = 5  ' 基準となるWindowの子WindowのうちトップレベルのWindow
' ***（ここまで）***

'-----------------------------------------------------------------
' 実行用マクロ
'-----------------------------------------------------------------
Sub マウスカーソル位置のウィンドウを取得()
    MsgBox "［OK］ボタンをクリックして ３ 秒後のマウスカーソル位置の" & vbLf & _
           "Windowのハンドル・クラス名一覧を作成します", vbInformation
    
    ' 3秒後にプロシージャ「createListOfWindowInformation」を実行する
    Application.OnTime Now() + TimeValue("00:00:03"), "createListOfWindowInformation"
End Sub

'-----------------------------------------------------------------
' ウィンドウ情報一覧を作成する
'-----------------------------------------------------------------
' マウスカーソル位置のウィンドウを調査し
' ウィンドウハンドルとクラス名、ウィンドウテキストの一覧を作成する
'［作成日］2024.12.08
' https://excel.syogyoumujou.com/memorandum/createlist_windowinformation.html
'-----------------------------------------------------------------
Private Sub createListOfWindowInformation()

    '--------------------------------------------
    ' マウスカーソル位置のウィンドウハンドル取得
    '--------------------------------------------
    Dim typPointapi  As POINTAPI
    Dim hdlFromPoint As LongPtr
    '《マウス カーソルの位置を画面座標で取得》
    Call GetCursorPos(typPointapi)

    '《指定したポイントを含むウィンドウのハンドルを取得》
    hdlFromPoint = WindowFromPoint(typPointapi.x, typPointapi.y)
    
    If hdlFromPoint = 0 Then
        MsgBox "マウスカーソル位置のウィンドウハンドルを取得できません", vbExclamation
        Exit Sub
    End If

    '--------------------------------------------
    ' 最上位の親ウィンドウハンドル取得
    '--------------------------------------------
    Dim hdlTarget As LongPtr
    Dim hdlParent As LongPtr
    hdlParent = hdlFromPoint
    Do
        hdlTarget = hdlParent
        '《指定したウィンドウの親または所有者へのハンドルを取得》
        hdlParent = GetParent(hdlTarget)
    Loop Until hdlParent = 0
    hdlParent = hdlTarget
    
    '--------------------------------------------
    ' 連想配列にウィンドウ情報を追加
    '--------------------------------------------
    Dim colWindowInfo As New Collection
    Dim lngHierarchy  As Long
    '《連想配列にウィンドウ情報（ハンドル・クラス名）を追加》
    ' ・ 引数1 ：対象とするウィンドウハンドル
    ' ・ 引数2 ：ウィンドウ情報を追加するコレクションオブジェクト
    ' ・ 引数3 ：階層を表す数値
    Call addWindowInfomationToCollection(hdlParent, colWindowInfo, lngHierarchy)

    '--------------------------------------------
    ' 結果を新規ブックに結果出力
    '--------------------------------------------
    ' 新規ブック追加
    Dim shtNew As Worksheet
    Set shtNew = Workbooks.Add.Worksheets(1)
    
    ' 出力
    Dim i            As Long
    Dim varSplit     As Variant
    Dim strHierarchy As String
    For i = 1 To colWindowInfo.Count
        varSplit = Split(colWindowInfo(i), "+@+")
        strHierarchy = String(varSplit(0), "　") & "[" & varSplit(0) & "]"
        shtNew.Cells(1 + i, "A").Resize(1, 4).Value = Array(strHierarchy, varSplit(1), varSplit(2), varSplit(3))
    Next
    
    ' 見出し設定・列幅調整
    With shtNew.Range("A1:D1")
        .Value = Array("階層", "クラス名", "ウィンドウハンドル", "ウィンドウテキスト")
        .Interior.Color = RGB(217, 217, 217)
        .EntireColumn.AutoFit
    End With

    ' マウスカーソル位置のウィンドウハンドルに色設定
    Dim varMatch As Variant
    varMatch = Application.Match(hdlFromPoint, shtNew.Columns(3), 0)
    If Not IsError(varMatch) Then shtNew.Cells(varMatch, 3).Interior.Color = vbYellow

End Sub

'-----------------------------------------------------------------
' 連想配列にウィンドウ情報（ハンドル・クラス名）を追加  《再帰型》
'-----------------------------------------------------------------
'［引数］
'   hdlTarget    ：対象とするウィンドウハンドル
'   colWindowInfo：ウィンドウ情報を追加するコレクションオブジェクト
'   Hierarchy    ：階層を表す数値
'［作成日］2024.12.07
' https://excel.syogyoumujou.com/memorandum/createlist_windowinformation.html
'-----------------------------------------------------------------
Private Sub addWindowInfomationToCollection(ByVal hdlTarget As LongPtr, _
                                            ByRef colWindowInfo As Collection, _
                                            ByVal Hierarchy As Long)
    If Hierarchy = -1 Then Exit Sub
    
    ' 階層に 1 加算
    Hierarchy = Hierarchy + 1
    
    Dim strClassName  As String
    Dim strWindowText As String
    Dim hdlChild      As LongPtr
    Do
        '--------------------------------------------
        ' ウィンドウ情報設定
        '--------------------------------------------
        ' クラス名取得
        strClassName = uGetClassName(hdlTarget)
        
        ' ウィンドウテキスト取得
        strWindowText = uGetWindowText(hdlTarget)
        
        ' 連想配列に対象ウィンドウ情報（階層・クラス名・ハンドル・テキスト）を追加
        ' ※「+@+」は区切り文字として使用
        colWindowInfo.Add Hierarchy - 1 & "+@+" & strClassName & "+@+" & hdlTarget & "+@+" & strWindowText
        
        '--------------------------------------------
        ' 子ウィンドウ調査
        '--------------------------------------------
        '《指定したウィンドウと関連するウィンドウへのハンドルを取得》
        ' ・ 引数1：対象のウィンドウハンドル
        ' ・ 引数2：指定したウィンドウとの関連を表すパラメーター
        ' 戻り値  ：ウィンドウハンドル ハンドルを取得できなかった場合は「0」
        hdlChild = GetWindow(hdlTarget, GW_CHILD)
        
        If hdlChild <> 0 Then
            ' 子ウィンドウが存在する場合は《再帰》
            Call addWindowInfomationToCollection(hdlChild, colWindowInfo, Hierarchy)
        End If

        If Hierarchy = 1 Then Exit Sub

        '--------------------------------------------
        ' 同じレベルウィンドウ調査
        '--------------------------------------------
        hdlTarget = GetWindow(hdlTarget, GW_HWNDNEXT)
    Loop Until hdlTarget = 0

    ' 階層を 1 減算
    Hierarchy = Hierarchy - 1
End Sub

'-----------------------------------------------------------------
' 指定したウィンドウハンドルのクラス名を取得
'-----------------------------------------------------------------
'［引数］
'   hdlTarget：対象とするウィンドウハンドル
'［戻り値］
'   クラス名が格納された文字列　失敗した場合は空の文字列
'［作成日］2024.12.07
' https://excel.syogyoumujou.com/memorandum/createlist_windowinformation.html
'-----------------------------------------------------------------
Private Function uGetClassName(ByVal hdlTarget As LongPtr) As String
    Dim lngResult    As Long
    Dim strClassName As String * 100

    '《指定したウィンドウが属するクラスの名前を取得》
    ' ・ 引数1 ：クラス名取得対象のウィンドウハンドル
    ' ・ 引数2 ：クラス名を受け取るバッファー（固定長文字列で指定）
    ' ・ 引数3 ：引数2のバッファーの文字数
    ' 戻り値   ：取得したクラス名の文字数　クラス名の取得に失敗した場合は「0」
    lngResult = GetClassName(hdlTarget, strClassName, Len(strClassName))
    
    If lngResult <> 0 Then
        ' 不要な空の文字列を削除し戻り値に設定
        uGetClassName = Replace$(strClassName, vbNullChar, "")
    End If
End Function

'-----------------------------------------------------------------
' 指定したウィンドウのテキストを取得
'-----------------------------------------------------------------
'［引数］
'   hdlTarget：対象とするウィンドウハンドル
'［戻り値］
'   ウィンドウテキストが格納された文字列　失敗した場合は空の文字列
'［作成日］2024.12.11
' https://excel.syogyoumujou.com/memorandum/createlist_windowinformation.html
'-----------------------------------------------------------------
Private Function uGetWindowText(ByVal hdlTarget As LongPtr) As String
    Dim lngResult    As Long
    Dim strWindowText As String * 100

    '《指定したウィンドウのテキストを取得》
    ' ・ 引数1 ：ウィンドウテキスト取得対象のウィンドウハンドル
    ' ・ 引数2 ：テキストを受け取るバッファー（固定長文字列で指定）
    ' ・ 引数3 ：引数2のバッファーの文字数
    ' 戻り値   ：取得したテキストの文字数　ウィンドウテキストの取得に失敗した場合は「0」
    lngResult = GetWindowText(hdlTarget, strWindowText, Len(strWindowText))
    
    If lngResult <> 0 Then
        ' 不要な空の文字列を削除し戻り値に設定
        uGetWindowText = Replace$(strWindowText, vbNullChar, "")
    End If
End Function