1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
'**********************************************************************************************************************
'* CREATEUR :Patricktoulon *
'* DATE :23/09/2010 *
'* UTILISATION D'UNE SEULE API LE "USER32.DLL" *
'* EXEMPLE DE USERFORM REDIMENTIONNABLE NOUVELLE VERSION *
'* LES CONTROLS SONT REDIMENTIONNES EN MEME TEMPS *
'* AINSI QUE LES FONT SIZE *
'**********************************************************************************************************************
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public old_largeur As Long, handle As Long, old_hauteur As Long, newhauteur As Single, newlargeur As Single
Public Ctl As MSForms.Control
Sub trois_boutons(uf As UserForm) 'on va ajouter les deux boutons manquants et l'élasticité a l'userform
'***************************************************************
'*ici on memorise les dimention de depart de l'userform *
old_largeur = uf.InsideWidth: old_hauteur = uf.InsideHeight '*
'***************************************************************
'***************************************************************************************************************
' ici on determine le handle par la classe de frame en testant la version de l'application ( DE EXCEL97 A 2007)*
handle = FindWindow("Thunder" & IIf(Application.Version Like "8*", "0*", "D") & "Frame", uf.Caption) '*
' ici on applique les changement (&h70000= les trois bouton et l'elasticité) *
SetWindowLong handle, -16, GetWindowLong(handle, -16) Or &H70000 '*
'***************************************************************************************************************
End Sub
Sub plein_ecran()
' on affiche le userform en plein ecran avec l'api showwindowa de la user32.dll _
bien moins lourd que mes versions precedente de maximisation de l'userform et plus rapide et plus propre
'1= mode normal
'3 =maximiser
'6 =minimiser
'le handle a été declaré en public au debut du module et _
identifier dans la routine des trois boutons il n'est donc plus necessaire de l'identifier
ShowWindow handle, 3
End Sub
Sub maForm_Resize(usf As UserForm)
'ici on determine le multiplicateur qui differenci la dimention de base a celle actuelle de l'userform
newlargeur = usf.InsideWidth / old_largeur: newhauteur = usf.InsideHeight / old_hauteur
'ici on boucle sur tout les controls
For Each Ctl In usf.Controls
'et on applique le multiplicateur au controls pour la largeur et la hauteur en une seule ligne
Ctl.Move Ctl.Left * newlargeur, Ctl.Top * newhauteur, Ctl.Width * newlargeur, Ctl.Height * newhauteur
' on a pris soin de metre un tag dans les propriétés a tout les controls qui n'ont pas de font size(image,scrollbar ,ect)
'et on applique la formule (userfom.width/ 48) Attention!!! cette valeur peut changer _
pour certaines personnes en fonction de la resolution de leurs ecrans
If Ctl.Tag = "" Then Ctl.Font.Size = (usf.InsideWidth / 48)
Next
'ici on indique que l'ancienne largeur devient la nouvelle largeur et pareil pour la hauteur indispensable pour un futur redimentionnement
old_largeur = usf.InsideWidth: old_hauteur = usf.InsideHeight: usf.Repaint
End Sub |
[source]Userform redimensionnable
: ça peut servir aux autres 
Répondre avec citation
Partager