Discussion :

[Garlim]

Bonjour à tous et à toutes.
Je ne poste pas souvent ici, mais je viens très souvent trouver des bonnes macros que j'utilise dans mon code.
J'ai une macro qui fait 22.640 lignes pour 9 userforms, 30 modules et 11 modules de classe et qui pèse 1Mo. Elle fait appel à plus d'une centaines de fichiers qui sont contenus dans le même répertoire sur un réseau. Je peux donc difficilement la partager.

J'utilise la macro de Patricktoulon qui permet de redimensionner la fenêtre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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 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 differencie la dimension 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 =vbNullString 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

Celle-ci marche très bien à un seul soucis près c'est que parfois, lorsque je minimise la fenêtre et que je la reprends plus tard, tous les éléments ont tellement été agrandis que je ne vois plus rien.

Après échanges j'ai mis en place une macro plus récente, mais ce coup-ci j'ai des problèmes de décochage de checkbox et de décalage de la ligne du bas en dehors de la userform.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Sub depart(usf)
 
    SetWindowLongA fwa(vbNullString, usf.Caption), -16, &H94CF0080  'Api window pour mettre les boutons minimiser et maximiser et l'élasticité
    usf.Tag = usf.Width & ":" & usf.Height    'on memorise les dimention du userform dans son tag
    nofont = "ScrollBar, SpinButton, Image"    'liste des controles qui n'ont pas de font
    For Each Ctrl In usf.Controls
        Ctrl.Tag = Ctrl.Left & ":" & Ctrl.Width & ":" & Ctrl.Top & ":" & Ctrl.Height    'on memorise les dimention des controles dans leur tag
        If Not nofont Like "*" & Left(TypeName(Ctrl), 5) & "*" Then Ctrl.Tag = Ctrl.Tag & ":" & Ctrl.Font.Size & ":" & usf.Width / Ctrl.Font.Size & ":" & usf.Height / Ctrl.Font.Size 'si il y a la propriété font alors on memorise aussi le fontsize
        If TypeName(Ctrl) = "ListBox" Then 'MEMORISATION DU COLUMNWIDTHS DE la listbox dans le tag sous la forme du string de l'array des dimentions
            tablwidth = Split(Replace(Ctrl.ColumnWidths, " pt", ""), ";")
            For i = 0 To UBound(tablwidth): tablwidth(i) = Val(tablwidth(i)): Next
            Ctrl.Tag = Ctrl.Tag & ":" & Join(tablwidth, "|")
        End If
 
    Next
End Sub
 
Sub maform_resize(usf)
    Dim WU, HU, D, Ctrl, tablwidth, i
    WU = usf.Width / Val(Split(usf.Tag, ":")(0)): HU = usf.Height / Val(Split(usf.Tag, ":")(1)) 'calcul du proprata
    For Each Ctrl In usf.Controls
        D = Split(Ctrl.Tag, ":")
        Ctrl.Move D(0) * WU, D(2) * HU, D(1) * WU, D(3) * HU 'redimentionnement par le prorata
        If UBound(Split(Ctrl.Tag, ":")) > 3 Then Ctrl.Font.Size = Round(D(4) * HU) + 1 'il il y a la propriété font on redimentionne le font
        If TypeName(Ctrl) = "ListBox" Then 'si c 'est une listbox on reconstruit le columnwidts avec l'array precédement memorisé dans le tag
            tablwidth = Split(D(5), "|")
            For i = 0 To UBound(tablwidth): tablwidth(i) = Val(tablwidth(i)) * WU: Next 'ON MET LES DIMENTIONS COLONNE A JOUR
            Ctrl.ColumnWidths = Join(tablwidth, " pt;") 'reconstruction du string columnwidths
        End If
    Next
End Sub

Et voilà l'effet sur la userform :
avant : (le décalage de la frame redressement n'apparaissait pas avant)

et après le redimensionnement.


Pourriez-vous m'aider à ce que les boutons ne dépassent pas de la userform?