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
お礼
返信が遅くなり、大変申し訳ございません。 現在、色々とGDI、GetObjectで色々と検索しながら試行錯誤中です。 具体的な手順まで指南していただき、本当にありがとうございます。 まだ解決はしていませんが、このまま何も返事を返さないのは失礼と思ったので取り急ぎ。。。 無事に解決したらまたこちらに結果を記載させて頂きます^^ ありがとうございました!!
補足
スイマセン、gooの教えて掲示板使うの初めてで…。 最初の内容はこちらに記述するべきだったんですね…。 ほんとゴメンナサイTT 解決しました!ありがとうございました!