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
お礼
分かりやすい回答有難う御座いました。 サーバへ保管して各担当者が開いているのですが、 各担当者が、いつも開いているサイズと変わってしまうのが駄目らしく 何とかならないかと言われました。(自分以外のデータベースも有ります) 開いた時のサイズをテキストなどに保管して閉じる時にMoveSizeで元に戻せないでしょうか？ とりあえずは教えて頂いた、Maximizeで閉じる事にします。
補足
開いた時のサイズを取り出す方法が分かりません。