'***********************************************************************
'module de resize userform proportionnelement a l'ecran en full screen
'auteur: patricktoulon
'version 2.6
'utilisation api en macro4(compatible All excel version
'on appelle ""dimensions me,1"" dans l'event activate de l'userform
'on appelle ""dimensions me,2"" dans l'event resize de l'userform
' si on veut les 3 boutons minimiser/reduire,fullscreen on appelle "treeButtonCaption"" dans le activate en premier
'***********************************************************************
Dim OldW#, OldH#
Sub treeButtonCaption()
Dim hwnd&
hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow
ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -16 & ", " & &H94CF0080 & ")") 'api SetWindowLongA
End Sub
Sub FullScreenU()
Dim hwnd&
hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow
ExecuteExcel4Macro ("CALL(""user32"",""ShowWindow"",""JJJ"",""" & hwnd & """,""" & 3 & """)") ' application du mode
End Sub
Sub Dimensions(USF As Object, Mode&)
Dim Ctrl, Fz&, cw$, NW#, NH#, dimo, TW, Z&
ecart = ((USF.Width - USF.InsideWidth) * 2)
If Mode = 1 Then
OldW = USF.Width + ecart: OldH = USF.Height + ecart
For Each Ctrl In USF.Controls
With Ctrl
.Tag = CDec(.Left) & "|" & .Top & "|" & .Width & "|" & CDec(.Height)
On Error Resume Next
Fz = .Font.Size
If Not Err Then .Tag = .Tag & "|" & Fz Else .Tag = .Tag & "|"
Err.Clear
If TypeName(Ctrl) = "ListBox" Then
cw = Ctrl.ColumnWidths: If cw = "" Then cw = Application.Rept("70;", Ctrl.ColumnCount + 1)
.Tag = .Tag & "|" & cw
End If
End With
Next
On Error GoTo 0
ElseIf Mode = 2 Then
For Each Ctrl In USF.Controls
NW = CDec(USF.Width / OldW): NH = CDec(USF.Height / OldH)
dimo = Split(Ctrl.Tag, "|")
Ctrl.Move CDec(dimo(0)) * NW, dimo(1) * NH, CDec(dimo(2)) * NW, CDec(dimo(3)) * NH
On Error Resume Next
Ctrl.Font.Size = Round(dimo(4) * Application.Min(NW, NH), 0)
Err.Clear
DoEvents
If TypeName(Ctrl) = "ListBox" Then
TW = Split(dimo(5), ";")
For I = 0 To UBound(TW): TW(I) = Val(TW(I)) * NW: Next
Ctrl.ColumnWidths = Join(TW)
End If
Next
On Error GoTo 0
ElseIf Mode = 3 Then
NW = USF.Width / OldW: NH = USF.Height / OldH
Z = Application.Min(400, 100 * Application.Min(NW, NH))
USF.Zoom = Z
End If
End Sub