[VBA] Largeur de colonnes dynamique

Version imprimable

26/04/2007, 09h27
ancel17

[VBA] Largeur de colonnes dynamique

Bonjour !

je voudrais savoir s'il est possible d'ajuster automatiquement la largeur des colonnes d'une liste en fonction de la valeur des différents champs ET du nom des différents champs.

Cordialement !
26/04/2007, 09h42
Invité

Bonjour

Fais des recherches ne commençant par là.

Starec
26/04/2007, 09h54
ancel17

Merci pour ta réponse, mais ma question concerne justement le formulaire de recherche de loufab !

les colonnes de ma liste ou sont affiché les résultats de la recherche sont auto-dimensionnées, mais seulement en fonction de la valeur des champs, mais de leur nom !

Par exemple, pour un champ numérique "volume total", la largeur de la colonne est basée sur la valeur 10 et non sur "volume total" qui est plus long !

D'autre part, l'ajustement des colonnes n'est effectif que si un choix est fait concernant les champs à afficher...
27/04/2007, 10h17
Invité

Re

As-tu vraiment tout lu ?

Dans un des messages, Loufab a indiqué une piste, voici le lien.

Starec
27/04/2007, 10h21
ancel17

si tu veux parlé de la solution de caféine, je l'ai testé, mais le problème est le même en pire, vu que les colonnes sont moins bien dimensionnées (en tout cas dans mon cas) !
27/04/2007, 10h23
Invité

Non

C'est le code qu'à mis Loufab dans son tuto

Starec
27/04/2007, 10h23
ancel17

je viens de recevoir un MP de loufab m'indiquant une piste pour mon problème.

je vais tenté de la mettre en forme et la testée.
Si c'est concluant, je posterai la solution !

En ce qui concerne le code du tuto de loufab, c'est le code que j'utilise, et pour lequel je cherche une réponse !

Tel qu'il est écrit, on ne prend pas en compte le nom des champs mais seulement la valeur qu'ils contiennent !
27/04/2007, 10h27
Invité

Ok

J'ai compris (on est vendredi), en fait le code de Loufab sert pour les données, il faut donc que tu récupéres la longueur de l'entête.

Est-ce que ton nom peut changer ?

Starec
27/04/2007, 10h32
ancel17

Comme cela concerne le formulaire de recherche, l'entête de la colonne peut varier selon les champs que l'on souhaite voir apparaître dans la liste.

je poste tout de suite la réponse de loufab, ça pourrait aider !

Citation:

Bonjour et merci d'avoir choisi mon tuto.

N'ayant que très peu de temps actuellement je te donne la piste à suivre pour cette modification.

Après la ligne de calcul de la longueur (la belle formule !) il faut récupérer la longueur du nom du champ. Propriété Fields(x).Name et faire le calcul de la longeur (len()). Comparer les 2 longeurs pour prendre la plus grande.

Si tu as des problèmes poste sur le forum.

Très cordialement,
27/04/2007, 10h48
Invité

Re

Il m'a coupé l'herbe sous les pieds, je pensais au field ici.

Starec

Voila maintenant plus de quatre heures (non trois parce que je suis allé manger) que je bloque et que je ne trouve pas la solution !

Voici le code de base (issu du tuto de loufab), si quelqu'un pouvait m'aider, ce serait génial !

Code:

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
 
' debut de selection des champs
    Dim strChamps As String
    Dim entCurrLigne As Integer
 
'----------- MODIFICATION ---------------
    Dim strLenCol As String         ' la variable
'----------- FIN MODIFICATION -----------
 
    For entCurrLigne = 0 To Me.lst_champs.ListCount - 1
        If Me.lst_champs.Selected(entCurrLigne) Then
            strChamps = strChamps & "[" & Me.lst_champs.Column(0, entCurrLigne) & "], "
 
'----------- MODIFICATION ---------------
            ' Largeur de colonne dynamique
            If Not strLenCol = "" Then strLenCol = strLenCol & "; "
            strLenCol = strLenCol & Round((Nz(DMax(Eval("""len([" & _
                        Me.lst_champs.Column(0, entCurrLigne) & "])"""), _
                        strTable, strCriteria), 0) * 130) / 571, 2) & " cm"
 
            ' méthode WizHook.TwipsFromFont Voir tuto de Cafeine
            'strLenCol = strLenCol & Round(GetTextLength(Me.lst_resultat, _
                        String(Nz(DMax(Eval("""len([" & Me.lst_champs.Column(0, entCurrLigne) & "])"""), _
                        strTable, strCriteria), 0), "u"), False) / 571, 2) & " cm"
 
            ' fin Largeur de colonne dynamique
'----------- FIN MODIFICATION -----------
 
        End If
    Next entCurrLigne
 
'----------- MODIFICATION ---------------
    Me.lst_resultat.ColumnWidths = strLenCol    ' Affecte Largeur de colonne dynamique
'----------- FIN MODIFICATION -----------
 
    If Len(strChamps) = 0 Then
        strChamps = strTable & ".*"
    Else
        strChamps = Left(strChamps, Len(strChamps) - 2)
    End If
    ' fin de selection des champs

Voila ma dernière tentative :

Code:

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
 
' debut de selection des champs
    Dim strChamps As String
    Dim entCurrLigne As Integer
 
    Dim strLenCol As String         ' la variable
 
    For entCurrLigne = 0 To Me.lst_champs.ListCount - 1
        If Me.lst_champs.Selected(entCurrLigne) Then
            strChamps = strChamps & "[" & Me.lst_champs.Column(0, entCurrLigne) & "], "
 
'----------- MODIFICATION ---------------
            Dim qry As QueryDef
            Dim i As Integer
            Dim lenVal As Integer
            Dim lenName As Integer
 
            Set qry = CurrentDb.QueryDefs(cbo_table)
 
            For i = 0 To Me.lst_champs.ListCount - 1
                If qry.Fields(i).Name = Me.lst_champs.Column(0, entCurrLigne) Then
                    lenVal = Len(Me.lst_champs.Column(0, entCurrLigne))
                    lenName = Len(qry.Fields(i).Name)
                End If
            Next i
 
            If lenVal > lenName Then
                ' Largeur de colonne dynamique
                If Not strLenCol = "" Then strLenCol = strLenCol & "; "
                strLenCol = strLenCol & Round((Nz(DMax(Eval("""len([" & _
                        Me.lst_champs.Column(0, entCurrLigne) & "])"""), _
                        strTable, strCriteria), 0) * 130) / 571, 2) & " cm"
            Else
                If Not strLenCol = "" Then strLenCol = strLenCol & "; "
                strLenCol = strLenCol & Round((Nz((Eval(Len(Me.lst_champs.Column(0, entCurrLigne)))), 0) * 130) / 571, 2) & " cm"
 
            End If
  '----------- FIN MODIFICATION -----------          
 
            ' méthode WizHook.TwipsFromFont Voir tuto de Cafeine
            'strLenCol = strLenCol & Round(GetTextLength(Me.lst_resultat, _
                        String(Nz(DMax(Eval("""len([" & Me.lst_champs.Column(0, entCurrLigne) & "])"""), _
                        strTable, strCriteria), 0), "u"), False) / 571, 2) & " cm"
 
            ' fin Largeur de colonne dynamique
 
            End If
    Next entCurrLigne
 
    Me.lst_resultat.ColumnWidths = strLenCol    ' Affecte Largeur de colonne dynamique
 
    If Len(strChamps) = 0 Then
        strChamps = strTable & ".*"
    Else
        strChamps = Left(strChamps, Len(strChamps) - 2)
    End If
    ' fin de selection des champs

je pense pas être trop loin du but, mais lorsque j'exécute le code, j'ai une erreur en relation avec la ligne de code suivante :

Code:

1
2
 
 Me.lst_resultat.ColumnWidths = strLenCol    ' Affecte Largeur de colonne dynamique

L'erreur provient certainement du fait que strLenCol = 1,59 cm2,5 cm... et non 1,59 cm; 2,5 cm;...

Je n'arrive pas à résoudre le problème...

Voici la dernière version de mes élucubrations.
Cette fois-ci, je prend bien en compte les noms des champs, mais plus les valeurs des champs, ou alors, il y a une erreur dans mon code, ce dont je ne doute pas !

Code:

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
 
' debut de selection des champs
    Dim strChamps As String
    Dim entCurrLigne As Integer
 
    Dim strLenCol As String         ' la variable
 
    For entCurrLigne = 0 To Me.lst_champs.ListCount - 1
        If Me.lst_champs.Selected(entCurrLigne) Then
            strChamps = strChamps & "[" & Me.lst_champs.Column(0, entCurrLigne) & "], "
 
            Dim qry As QueryDef
            Dim i As Integer
            Dim lenVal As Integer           'longueur valeur champ
            Dim lenName As Integer        'longueur nom champ
 
            Set qry = CurrentDb.QueryDefs(cbo_table.Value)
 
            For i = 0 To Me.lst_champs.ListCount - 1
                If qry.Fields(i).Name = Me.lst_champs.Column(0, entCurrLigne) Then
                    lenVal = Len(Me.lst_champs.Column(0, entCurrLigne))
                    lenName = Len(qry.Fields(i).Name)
                End If
            Next i
 
            If lenVal > lenName Then
                ' Largeur de colonne dynamique
                If Not strLenCol = "" Then strLenCol = strLenCol & "; "
                strLenCol = strLenCol & Round((Nz(DMax(Eval("""len([" & _
                        Me.lst_champs.Column(0, entCurrLigne) & "])"""), _
                        strTable, strCriteria), 0) * 130) / 571, 2) & " cm"
            Else
                If Not strLenCol = "" Then strLenCol = strLenCol & "; "
                strLenCol = strLenCol & Round((Nz((Eval(Len(Me.lst_champs.Column(0, entCurrLigne)))), 0) * 130) / 571, 2) & " cm"
 
            End If
 
            ' fin Largeur de colonne dynamique
 
            End If
    Next entCurrLigne
 
    Me.lst_resultat.ColumnWidths = strLenCol    ' Affecte Largeur de colonne dynamique
 
    If Len(strChamps) = 0 Then
        strChamps = strTable & ".*"
    Else
        strChamps = Left(strChamps, Len(strChamps) - 2)
    End If
    ' fin de selection des champs

Où est l'erreur ?

02/05/2007, 10h29
ancel17

J'en suis donc toujours au même point, donc si quelqu'un avait la solution, ou même une piste pour la correction du code, je lui en serai très reconnaissant !

Bonjour,

Voici le code à insérer à la place de l'ancien.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Dim lenVal  ' la taille de la valeur
Dim lenNam  ' la taille du nom du champ
For entCurrLigne = 0 To Me.Lst_Champs.ListCount - 1
        If Me.Lst_Champs.Selected(entCurrLigne) Then
 
            strChamps = strChamps & "[" & Me.Lst_Champs.Column(0, entCurrLigne) & "], "
 
            ' longueur valeur
            lenVal = Nz(DMax(Eval("""len([" & Me.Lst_Champs.Column(0, entCurrLigne) & "])"""), strtable, strCriteria), 0)
            ' longueur nom
            lenNam = Len(Me.Lst_Champs.Column(0, entCurrLigne))
            If lenVal < lenNam Then lenVal = lenNam ' nom plus long que valeur
 
            If Not strLenCol = "" Then strLenCol = strLenCol & "; "  ' ajoute le séparateur
 
            strLenCol = strLenCol & Round((lenVal * 130) / 571, 2) & " cm"  ' puis la valeur
            ' méthode WizHook.TwipsFromFont Voir tuto de Cafeine
            'strLenCol = strLenCol & Round(GetTextLength(Me.lst_resultat, _
                        String(lenval, "u"), False) / 571, 2) & " cm"
        End If
 
Next entCurrLigne

Réponse tardive car beaucoup de boulot...

Cordialement,

14/05/2007, 15h29
ancel17

Merci beaucoup loufab !

Comme on dit mieux vaut tard que jamais, et comme je pense que ça pourrait servir à beaucoup de monde, c'est super d'avoir pris sur ton temps pour résoudre le problème !

Encore merci ! :king: