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

Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hWnd As LongPtr, _
    ByVal dwId As Long, _
    riid As Any, _
    ppvObject As Object) As Long

Sub OuvrirWorddefaut2()
    Dim fichier, AppHandle As LongPtr, N$, used As Boolean
    If TaskPaneUsed Then MsgBox " le volet est deja utilisé" & vbCrLf & "Vous devez fermer le volet actuel": Exit Sub
    
    fichier = Application.GetOpenFilename("pdf Files (*.doc*), *.doc*", 1, "ouvrir un fichier")
    If fichier = "Faux" Then Exit Sub
    Set wordxapp = CreateObject("word.application")
    With wordxapp
        .Visible = True
        .documents.Open fichier
    End With
    N = Split(Mid(fichier, InStrRev(fichier, "\") + 1), ".")(0)
    AppHandle = GetWinHandle("OpusApp", N, 10)
    If [D1] = "Vrai" Then SetWindowLong AppHandle, -16, &H16000000
    'docking AppHandle
    Dim AppForm As LongPtr
    If TaskPaneUsed Then MsgBox " le volet est deja utilisé" & vbCrLf & "Vous devez fermer le volet actuel": Exit Sub
    Set usf = plaque
    With usf
        .Show 0
    End With
    AppForm = GetActiveWindow
    If [D1] = "Vrai" Then SetWindowLong AppHandle, -16, &H16000000 'checkbox on vire la caption
    wordxapp.left = 0
    wordxapp.top = 0
    
    SetParent AppHandle, AppForm
    docking AppForm
End Sub

Sub OuvrirPDFdefaut()
    Dim AppHandle As LongPtr
    Dim Hnewparent As LongPtr
    Dim He7 As LongPtr
    Dim fichier$
    Dim appPdfDefaut As PdfAppInfo, used As Boolean
    If TaskPaneUsed Then MsgBox " le volet est deja utilisé" & vbCrLf & "Vous devez fermer le volet actuel": Exit Sub
    
    fichier = Application.GetOpenFilename("pdf Files (*.pdf), *.pdf", 1, "ouvrir un fichier")
    If fichier = "Faux" Then Exit Sub
    
    appPdfDefaut = GetPdfDefaultExe 'recherche du chemin de l'exe de l'application par défaut avec ma fonction magic
    
    Select Case appPdfDefaut.ExeName
            'on fait une exeption pour edge et chrome on passe en shell cmd pour ouvrir en << new window  >>
            'comme ca on evite d'avoir plusieurs onglets dans la fenêtre chrome ou edge ou FF
        Case "msedge.exe", "chrome.exe", "firefox.exe"
            Dim pdfURL$, t
            pdfURL = "file:///" & Replace(fichier, "\", "/") ' Format de l'URL pour Edge
         Shell "cmd /c start """ & """" & " " & Replace(appPdfDefaut.ExeName, ".exe", "") & " --new-window """ & pdfURL & """", vbHide
  Case Else: ShellExecute 0, "open", fichier, "", "", 1 ' SW_SHOWNORMAL
    End Select
    
    'on garde que le nom du fichier sans l'extension
    N = Split(Mid(fichier, InStrRev(fichier, "\") + 1), ".")(0)
    
    Select Case appPdfDefaut.ExeName
        Case "Acrobat.exe": AppHandle = GetWinHandle("AcrobatSDIWindow", N, 10)
        Case "PDFXCview.exe": AppHandle = GetWinHandle("DSUI:PDFXCViewer", , 10)
        Case "msedge.exe", "chrome.exe": AppHandle = GetWinHandle("Chrome_WidgetWin_1", N, 10)
        Case "firefox.exe": AppHandle = GetWinHandle("MozillaWindowClass", N, 10)
        Case Else: AppHandle = GetWinHandle("*", N, 10)
    End Select
    If [D1] = "Vrai" Then SetWindowLong AppHandle, -16, &H16000000
    docking AppHandle
End Sub

'Cette fonction ferme les fenêtres intégrées dans Excel qui ont une certaine classe
'elle Restaure la largeur la fenêtre de classe "EXCEL7 dans la fenêtre Excel
Sub Fermeture_du_volet_Ouvert()
    'patricktoulon:exercice (docked work pane)
    Dim t, i&, hwnd As LongPtr
    ActiveCell.Select
    'j'ouvre word avec un object application
    'donc je le ferme directe si il existe  et le select case ensuite fermera le userform le contenant par la classe ThunderDFrame pour  la version ouvrirworddefaut2
    If Not wordxapp Is Nothing Then wordxapp.Quit
    t = AllPartExcelWindowList 'liste des composantes prrésente dans excel
    For i = 2 To UBound(t)
        Select Case True
            Case CStr(t(i, 2)) = "ThunderDFrame": hwnd = CLngPtr(t(i, 1)): Unload usf: Exit For
            Case CStr(t(i, 2)) = "Notepad": hwnd = CLngPtr(t(i, 1)): Exit For
            Case CStr(t(i, 2)) Like "Chrome_WidgetWin*": hwnd = CLngPtr(t(i, 1)): Exit For
            Case CStr(t(i, 2)) Like "MozillaWindowClass*": hwnd = CLngPtr(t(i, 1)): Exit For
            Case CStr(t(i, 2)) = "AcrobatSDIWindow": hwnd = CLngPtr(t(i, 1)): Exit For
            Case CStr(t(i, 2)) Like "*Acrobat*": hwnd = CLngPtr(t(i, 1)): Exit For
            Case CStr(t(i, 2)) = "Notepad++": hwnd = CLngPtr(t(i, 1)): Exit For
            Case CStr(t(i, 2)) = "DSUI:PDFXCViewer": hwnd = CLngPtr(t(i, 1)): Exit For
            Case CStr(t(i, 2)) = "OpusApp": hwnd = CLngPtr(t(i, 1)):
                If Not wordxapp Is Nothing Then wordxapp.Quit
                Exit For
                
        End Select
    Next
    If hwnd <> 0 Then
        Call PostMessage(hwnd, &H10, 0, 0)
    Else
        MsgBox "Il n'y a pas de volet en cours d'affichage", vbInformation: Exit Sub
    End If
    'Vx = False
    DoEvents
    splitViewRestaure
    Set wordxapp = Nothing
End Sub

    If hWnd = 0 Then
        hWnd = Application.hWnd
        i = 0
        Static TbL(1 To 100, 1 To 9) As Variant
        Dim ti As Integer
        Dim tj As Integer
        For ti = 1 To UBound(TbL, 1)
            For tj = 1 To UBound(TbL, 2)
                TbL(ti, tj) = Empty
            Next tj
        Next ti
    End If

sub test

dim T

for i= 1 to 10

T=AllPartExcelWindowList

debug.print ubound(T) &" handle trouvés"

next

end sub

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
  <ribbon startFromScratch="true"/>
</customUI>

Sub OuvrirAvecModeleSansRuban()
    Dim wdApp As Object
    Dim wdDoc As Object
  
    Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Open("C:\chemin\MonDocument.docm")
  
    ' Attache le modèle qui supprime le ruban
    wdDoc.AttachedTemplate = "C:\chemin\ModeSansRuban.dotm"
  
    wdApp.Visible = True
End Sub