Microsoft 365 UserForm maximiser la taille du formulaire par rapport à la taille de l'écran

Private Sub UserForm_Initialize()

' Dimensions de l'écran
Dim wS As Long, hS As Long
    'wS = GetSystemMetrics32(0) ' width in points
    'hS = GetSystemMetrics32(1) ' height in points
    wS = Application.Width ' width in points
    hS = Application.Height ' height in points

' Dimensions du UserForm
If wS / hS > 1.291139 Then ' Cas où la limitation du formulaire sera sur sa hauteur
    Me.Height = hS
    Me.Width = hS * 1.291139
Else ' Cas où la limitation du formulaire sera sur sa largeur
    Me.Width = wS
    Me.Height = wS / 1.291139
    
End If

'**********************************************************************************************
'          Utilisisation des api sans déclaration avec les macro4
'                 appliquer un mode d'affichage a l'userform
'patricktoulon
'
'SW_HIDE            0 Cache la fenêtre et en active une autre.
'SW_MAXIMIZE        3 Agrandit la fenêtre.
'SW_MINIMIZE        6 Réduit la fenêtre et active la prochaine (dans l'ordre des tâches windows).
'SW_RESTORE         9 Active et affiche la fenêtre à sa taille et position initiales.
'SW_SHOW            5 Active et affiche la fenêtre.
'SW_SHOWMAXIMIZED   3 Active et agrandit la fenêtre.
'SW_SHOWMINIMIZED   2 Active et réduit la fenêtre.
'SW_SHOWNA          8 Identique à SW_SHOW sauf que la fenêtre n'est pas activée.
'**********************************************************************************************

'EXEMPLE show full screen
Private Sub UserForm_Activate()
    FullScreen 3
End Sub

Private Sub FullScreen(mode)
    Dim hwnd&
    hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")")         'api GetActiveWindow Capture du handle de la fenetre active
    ExecuteExcel4Macro ("CALL(""user32"",""ShowWindow"",""JJJ"",""" & hwnd & """,""" & mode & """)")    ' application du mode
    ' et si tu veux les trois bouton debloque la ligne ci dessous
    'ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -16 & ", " & &H94CF0080 & ")")     'api SetWindowLongA
End Sub

Option Explicit
Function ptopx()    'fonction coeff point to pixel
   Dim z#
   With ActiveWindow.Panes(1): z = .Parent.Zoom / 100: ptopx = (.PointsToScreenPixelsX(72 * z) - .PointsToScreenPixelsX(0)) / 72: End With
End Function

Private Sub UserForm_Activate()
    Dim W#, H#, capt#, border#, UFW#, UFH#, ratw#, rath#, ratfontSize&, ctrl
    UFW = Me.Width: UFH = Me.Height
    W = ExecuteExcel4Macro("CALL(""user32"",""GetSystemMetrics"",""jjj""," & 0 & ")") / ptopx
    H = ExecuteExcel4Macro("CALL(""user32"",""GetSystemMetrics"",""jjj""," & 1 & ")") / ptopx
    capt = ExecuteExcel4Macro("CALL(""user32"",""GetSystemMetrics"",""jjj""," & 14 & ")") / ptopx
    border = ExecuteExcel4Macro("CALL(""user32"",""GetSystemMetrics"",""jjj""," & 32 & ")") / ptopx
    Me.Move 0, 0, W, H - capt - border
    ratw = Me.Width / UFW: rath = Me.Height / UFH
    ratfontSize& = Application.Min(ratw, rath)
    For Each ctrl In Me.Controls
        With ctrl: .Move .Left * ratw, .Top * rath, .Width * ratw, .Height * rath:
        On Error Resume Next
        .Font.Size = .Font.Size * ratfontSize
        Err.Clear
        End With
    Next
End Sub