'appelle des fonctions:
'--------------------------------------------------------------------------------------------
'fonction Charge_Size
'
'placer le code suivant dans l'évenement Load de la feuille:
'Charge_Size Me, 0
'Me.Height = 'hauteur de la feuille désirée au chargement
'Me.Width = 'largeur de la feuille désirée au chargement
'Charge_Size Me, 0
'
'placer le code suivant dans l'évenement Activate de la feuille:
'Charge_Size Me, 1
'
'placer le code suivant dans l'évenement QueryUnload de la feuille:
'Charge_Size Me, 2
'--------------------------------------------------------------------------------------------
'fonction F_Resize
'placer le code suivant dans l'évenement QueryUnload de la feuille:
'F_Resize Me
'--------------------------------------------------------------------------------------------
'attention pour les ListBox il faut forcer le paramètre IntegralHeight à False
Global F_Size(20) As F_Dimension
Global Flag_Size As Integer
Global Event_Info As EventInfo
Global Flag_Load As Boolean
Public Type F_Dimension
Name As String
Hauteur As Integer
Largeur As Integer
H_Default As Integer
L_Default As Integer
H_Last As Integer
L_Last As Integer
End Type
Public Function Charge_Size(Controle As Form, Event_Info As Integer)
Dim i As Integer
i = 0
On Error GoTo Erreur
If Event_Info = 0 Then
If Flag_Size <> 0 Then
Flag_Size = 0
Else
Flag_Load = True
End If
ElseIf Event_Info = 1 Then
If Flag_Load = True Then
Flag_Load = False
F_Size(0).Name = Controle.Name
F_Size(0).H_Default = Controle.Height
F_Size(0).L_Default = Controle.Width
Do Until F_Size(i).Name = ""
i = i + 1
Loop
F_Size(i).Name = F_Size(0).Name
F_Size(i).H_Default = F_Size(0).H_Default
F_Size(i).L_Default = F_Size(0).L_Default
Flag_Size = Flag_Size + 1
Else
F_Size(0).Name = Controle.Name
i = 1
Do Until F_Size(i).Name = F_Size(0).Name
i = i + 1
Loop
F_Size(0).H_Default = F_Size(i).H_Default
F_Size(0).L_Default = F_Size(i).L_Default
Flag_Size = Flag_Size + 1
End If
ElseIf Event_Info = 2 Then
i = 1
Do Until F_Size(i).Name = Controle.Name
i = i + 1
Loop
F_Size(i).Name = ""
F_Size(i).H_Default = 0
F_Size(i).L_Default = 0
Controle.Height = F_Size(0).H_Default
Controle.Width = F_Size(0).L_Default
F_Resize Controle
End If
F_Size(0).H_Last = Controle.Height
F_Size(0).L_Last = Controle.Width
F_Size(0).Hauteur = Controle.Height
F_Size(0).Largeur = Controle.Width
Exit Function
Erreur:
Controle.Hide
Controle.WindowState = 0
Resume
End Function
Public Function F_Resize(Controle As Form)
If Flag_Size <> 0 Then
If Controle.Height <= 360 Then
F_Size(0).Hauteur = F_Size(0).H_Last
F_Size(0).Largeur = F_Size(0).L_Last
Exit Function
End If
If Controle.Height < F_Size(0).H_Default Then
Controle.Height = F_Size(0).H_Default
End If
If Controle.Width < F_Size(0).L_Default Then
Controle.Width = F_Size(0).L_Default
End If
On Error Resume Next
Dim Resiz As Double
For Each Control In Controle
If TypeOf Control Is CommandButton Or TypeOf Control Is TextBox Or TypeOf Control Is Frame Or TypeOf Control Is ListBox Or TypeOf Control Is OptionButton Or TypeOf Control Is CheckBox Then
Resiz = Controle.Height / F_Size(0).Hauteur
Control.Top = Control.Top * Resiz
Control.Height = Control.Height * Resiz
Resiz = Controle.Width / F_Size(0).Largeur
Control.Left = Control.Left * Resiz
Control.Width = Control.Width * Resiz
'If (TypeOf control Is CommandButton Or TypeOf control Is Frame Or TypeOf control Is OptionButton) And (Controle.Width <> F_Size.Largeur) And (Controle.Height <> F_Size.Hauteur) Then
' control.Font.Size = control.Font.Size * Resiz
'End If
'MsgBox control
Else
'Resiz = Controle.Height / F_Size.Hauteur
'control.Height = control.Height * Resiz
'Resiz = Controle.Width / F_Size.Largeur
'control.Width = control.Width * Resiz
End If
Next
F_Size(0).H_Last = Controle.Height
F_Size(0).L_Last = Controle.Width
F_Size(0).Hauteur = Controle.Height
F_Size(0).Largeur = Controle.Width
End If
End Function