VBA ウィンドウの列挙 Win32 API
http://d.hatena.ne.jp/cartooh/20090618
上記のページに記載されているVBAです。
動作は確認できたのですが、どのような処理の流れとなっているのかがわかりません。
どなたかコメントを付けていただけないでしょうか。
よろしくお願いいたします。
Option Explicit
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal cnm As String, ByVal cap As String) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Const INDENT_KEY = "INDENT"
Public Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long
EnumChildWindowsProc = EnumWindowsProc(hWnd, lParam)
End Function
Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long
EnumWindowsProc = True
If IsWindowVisible(hWnd) = 0 Then
Exit Function
End If
Dim strClassName As String ' * 255
Dim strCaption As String ' * 255
strClassName = String(255, vbNullChar)
strCaption = String(255, vbNullChar)
GetWindowText hWnd, strCaption, Len(strCaption)
GetClassName hWnd, strClassName, Len(strClassName)
strCaption = RTrim(left(strCaption, InStr(1, strCaption, vbNullChar) - 1))
strClassName = RTrim(left(strClassName, InStr(1, strClassName, vbNullChar) - 1))
ActiveCell.Cells(1, 1).Value = Hex(hWnd)
ActiveCell.Cells(1, 2).Value = IsWindowVisible(hWnd)
ActiveCell.Cells(1, 3).Value = strCaption
ActiveCell.Cells(1, 4).Value = strClassName
ActiveCell.Cells(2, 2).Activate
Dim c As Collection
Set c = lParam
Dim indent As Long
indent = c(INDENT_KEY)
c.Add String(indent * 2, " ") & Hex(hWnd) & " " & strCaption & " " & strClassName, before:=c.Count
indent = indent + 1
c.Remove INDENT_KEY
c.Add indent, INDENT_KEY
Call EnumChildWindows(hWnd, AddressOf EnumChildWindowsProc, ObjPtr(c))
indent = c(INDENT_KEY) - 1
c.Remove INDENT_KEY
c.Add indent, INDENT_KEY
ActiveCell.Cells(1, 0).Activate
End Function
Sub hoge()
Application.ScreenUpdating = False
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets(1)
sht.UsedRange.Clear
sht.Activate
sht.Range("A1").Activate
Dim c As Collection
Set c = New Collection
c.Add 0, INDENT_KEY
Dim ret As Long
ret = EnumWindows(AddressOf EnumWindowsProc, ObjPtr(c))
c.Remove INDENT_KEY
Set sht = ThisWorkbook.Worksheets(2)
sht.UsedRange.Clear
sht.Activate
sht.Range("A1").Activate
Dim o As Variant
For Each o In c
ActiveCell.Value = o
ActiveCell.Cells(2, 1).Activate
Next
Application.ScreenUpdating = True
End Sub
お礼
早速、大変ご丁寧な回答をいただき、 ありがとうございます。 示していただいた参照先についてはまだ確認できていませんが、回答いただいた内容と合わせ、試してみたいと思います。 取り急ぎお礼まで。
補足
教えていただいた参照先のサンプルコードを確認し、 本質問の異常終了の原因がわかりました。 (原因) ４行目のコールバック関数引数の宣言が間違っていました(「ByVal」が抜けていました)。 下記のように修正することでうまく動作することが確認できました。大変お世話になりありがとうございました。 04 Function ListupChildWindows(ByVal hWnd as LongPtr, ByVal lParam as Long) as Boolean