Type POINTAPI
x As Long
y As Long
End Type
Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Type WINDOWPLACEMENT
length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
'ウィンドウハンドル取得
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'子ウィンドウハンドル列挙
Declare Function EnumChildWindows Lib "user32" ( _
ByVal hWndParent As Long, _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
'ウィンドウの位置・状態を取得
Declare Function GetWindowPlacement Lib "user32" Alias "GetWindowPlacement" ( _
ByVal hWnd&, lpwndpl As WINDOWPLACEMENT) 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
Public Sub Command1_Click()
On Error Resume Next
Dim Ret As Long
Dim putText As String
Dim hWnd As Long
rowNo = 1
'親ウィンドウハンドル取得（testというAccessのアプリ名）
hWnd = FindWindow(vbNullString, "test")
'子ウィンドウハンドル列挙
Ret = EnumChildWindows(hWnd, AddressOf EnumChildProc, 0)
End Sub
Public Function EnumChildProc(ByVal hWnd As Long) As Long
Dim Ret As Long
Dim Leng As Long
Dim Name As String
Dim putText As String
Dim WinPt As WINDOWPLACEMENT
'バッファ確保
Name = String(255, Chr(0))
Leng = Len(Name)
'名前を取得する
Ret = GetWindowText(hWnd, Name, Leng)
If Ret <> 0 Then
putText = Replace(Name, Chr(0), "")
End If
'ウィンドウのキャプション（テキスト）をExcelへ吐き出し
Range(Cells(rowNo, 1), Cells(rowNo, 1)).Value = putText
Name = String(255, Chr(0))
Leng = Len(Name)
'クラス名取得
Ret = GetClassName(hWnd, Name, Leng)
If Ret <> 0 Then
putText = Replace(Name, Chr(0), "")
'クラス名をExcelへ吐き出し
Range(Cells(rowNo, 2), Cells(rowNo, 2)).Value = putText
If InStr(1, putText, "MDIClient") > 0 Then
'MDIの場合、その子ウィンドウを取得する
Ret = EnumChildWindows(hWnd, AddressOf EnumChildProc, 0)
End If
End If
WinPt.length = Len(WinPt)
'ウィンドウの配置方法を取得
Ret = GetWindowPlacement(hWnd, WinPt)
If Ret <> 0 Then
'ウィンドウのポジションをExcelへ吐き出し
Range(Cells(rowNo, 3), Cells(rowNo, 3)).Value = WinPt.rcNormalPosition.top
Range(Cells(rowNo, 4), Cells(rowNo, 4)).Value = WinPt.rcNormalPosition.left
End If
rowNo = rowNo + 1
EnumChildProc = 1
End Function
|
