XL 2016 VBA - Réduire la largeur de la grille Excel

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'                                   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

Sub hexaustiveList()
 t = AllPartExcelWindowList
Sheets(2).Cells(1).Resize(, 9) = Split("handle,classe,left,top,right,bottom,width,height,parenthandle", ",")
Sheets(2).Cells(2, 1).Resize(50, 9) = t
End Sub

Sub testsimple()
     SplitExcelView
End Sub



Sub SplitExcelView(Optional HwndForm As LongPtr = 0)
    Dim t
    t = AllPartExcelWindowList
    Dim hwnd As LongPtr
    For i = 1 To UBound(t)
        If t(i, 2) = "EXCEL7" Then
            hwnd = t(i, 1)
            SetWindowPos hwnd, 0, 0, 0, t(i, 7) / 2, t(i, 8), 0&
            If HwndForm <> 0 Then
                SetParent HwndForm, t(i, 9)
                SetWindowPos HwndForm, 0, t(i, 7) / 2, 0, t(i, 7) / 2, t(i, 8), 0&
            End If
        End If
    Next
End Sub

Sub Grillefullstack()
  Dim t
    t = AllPartExcelWindowList
    Dim hwnd As LongPtr
    For i = 1 To UBound(t)
        If t(i, 2) = "EXCEL7" Then
            hwnd = t(i, 1)
            SetWindowPos hwnd, 0, 0, 0, t(2, 5), t(i, 8), 0&
            If HwndForm <> 0 Then
                SetParent HwndForm, t(i, 9)
                SetWindowPos HwndForm, 0, t(i, 7) / 2, 0, t(i, 7) / 2, t(i, 8), 0&
            End If
        End If
    Next
End Sub