'*****************************************************************************************************
' ___ _ _______ __ _ ____ _ _ _______ ___ _ _ _ ___ _ _.
' // \\ /\\ // // \\ // // // // // // \\ // // // // \\ //| //
' //___// //__\ // //__// // // //__// // // // // // // // // // | //
' // // \\ // // \\ // // // \\ // // // // // // // // // | //
'// // // // // // // //___ // \\ // \\__// //__// //___ \\__// // |//
'****************************************************************************************************
' fonction api pour décortiquer les elements d'une fenêtre Excel
'Auteur:patricktoulon sur Developpez.com
'version 1.3
'date version:17/02/2015
'mise à jour 22/06/2024
'transformation en fonction retournant le tableau des fentre avec les propriété
'(handel,classe,left,top,right,bottom,width,height,handle parent)
'****************************************************************************************************
Private Declare PtrSafe Function GetWindow Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal uCmd As Long) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
ByVal hwnd As LongPtr, ByVal lpst As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function IsWindow Lib "user32" ( _
ByVal hwnd As LongPtr) As Boolean
Declare PtrSafe Function GetWindowRect Lib "user32" ( _
ByVal hwnd As LongPtr, lpRect As RECT) As Long
Declare PtrSafe Function GetSystemMetrics Lib "user32" ( _
ByVal nIndex As Long) As Long
Declare PtrSafe Function GetDpiForWindow Lib "user32" ( _
ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function SetWindowPos Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, _
ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function GetParent Lib "user32" ( _
ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function SetParent Lib "user32" ( _
ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Const GW_CHILD = 5
Const GW_HWNDNEXT = 2
Public Function AllPartExcelWindowList(Optional ByVal hwnd As LongPtr = 0) As Variant
Dim hWndChild As LongPtr, hWndSibling As LongPtr
Dim st$, ClassNameLength&, r As RECT
Static i&
If hwnd = 0 Then hwnd = Application.hwnd: i = 0: Static tbl(1 To 50, 1 To 9) As Variant
If i >= UBound(tbl, 1) Then
AllPartExcelWindowList = tbl
Exit Function
End If
If IsWindow(hwnd) Then
st = String(256, vbNullChar)
ClassNameLength = GetClassName(hwnd, st, Len(st))
st = left(st, ClassNameLength)
GetWindowRect hwnd, r
i = i + 1
tbl(i, 1) = hwnd
tbl(i, 2) = Trim(st)
tbl(i, 3) = r.left
tbl(i, 4) = r.top
tbl(i, 5) = r.right
tbl(i, 6) = r.bottom
tbl(i, 7) = r.right - r.left
tbl(i, 8) = r.bottom - r.top
tbl(i, 9) = GetParent(hwnd)
End If
' explorer les enfants
hWndChild = GetWindow(hwnd, GW_CHILD)
Do While hWndChild <> 0 And i < UBound(tbl, 1)
If IsWindow(hWndChild) Then
Call AllPartExcelWindowList(hWndChild) ' récursivité directe
End If
hWndChild = GetWindow(hWndChild, GW_HWNDNEXT)
Loop
' retour final
If hwnd = Application.hwnd Then
AllPartExcelWindowList = tbl
End If
End Function