Autres dimensionner une listbox pour DUDU2

[patricktoulon]

BONJOUR @Dudu2
Private Sub UserForm_Activate()
ListBox1.List = [A1:A8].Value
ecx = Me.Width - Me.InsideWidth
With Me.Controls.Add("forms.Label.1", "cobaie")
.Width = 500
.Height = 200
.Font.Name = ListBox1.Font.Name
.BackColor = vbYellow
.BorderStyle = ListBox1.BorderStyle
' .SpecialEffect = ListBox1.SpecialEffect
.Font.Size = ListBox1.Font.Size
.Font.Bold = ListBox1.Font.Bold
.Caption = "toto"
.AutoSize = True
.Top = ListBox1.Top
.Left = ListBox1.Left + ListBox1.Width
ListBox1.Height = ((.Height + 0.25) * ListBox1.ListCount)
MsgBox "théoriquement un item mesure " & .Height & " points de haut"
'Me.Controls.Remove (.Name)
End With
End Sub

 

[patricktoulon]

je l'ai intégrer dans ma méthode aussi
du coup j'ai même la hauteur d'un item

Sub resizeListBox(usf, listbox As Object)
    'patricktoulon
    'MsgBox GetSystemMetrics(36)
    Dim txt, speffect, BdStyle, X&, hitem
    speffect = listbox.SpecialEffect
    BdStyle = listbox.BorderStyle
    txt = Join(Application.Transpose(listbox.List), vbCrLf)
    With usf.Controls.Add("forms.Textbox.1", "cobaie")
        DoEvents
        .IntegralHeight = listbox.IntegralHeight
        '.SpecialEffect = speffect'ne pas modifier le SpecialAffect
        .MultiLine = True
        .Value = CStr(txt)
        .Width = 500
        .Height = listbox.ListCount * 50 '50 points de font fois le count de la liste pour avoir de la marge dans son utilisation
        .BorderStyle = BdStyle
        .Font.Size = listbox.Font.Size
        .Font.Name = listbox.Font.Name
        .Font.Bold = listbox.Font.Bold
        .AutoSize = True
        hitem = (.Height / listbox.ListCount) * Abs(listbox.ColumnHeads)
        listbox.Height = .Height + hitem
        listbox.ColumnWidths = Replace(.Width & ";0", ".", ",")
        listbox.Width = .Width + 3 '(Getsyemmetrics(36)
        listbox.BorderStyle = BdStyle
        listbox.SpecialEffect = speffect
         usf.Controls.Remove ("cobaie")
    MsgBox listbox.Height / listbox.ListCount
    End With
End Sub

avec un résultat toujours aussi parfait

 

[Dudu2]

Je crois qu'on a bouclé l'affaire, chacun avec sa méthode, @job75, @patricktoulon et @Dudu2 !
Heureusement parce que j'ai passé un sacré paquets d'heures

sur ce truc totalement futile

et je suis content d'en être enfin libéré.

 

[patricktoulon]

re ben j'en ai passé tout autant au moins
surtout que quand on réfléchi l'utilité de la chose est rare
cela dit je ne suis pas déçu j'ai découvert plein de chose
par exemple
l'instabilité de la méthode IntégralHeight(false /height 0 / true /h=.height) ne fonctionne pas a tout les coups
et d'autres plus importantes comme le asynchrone par exemple quand on règle des propriétés
je sais maintenant comment maitriser ces petit tracas

je me vois bien le mettre dans mon faux menu contextuel (avec une listbox)dans userform dans les ressources par exemple

 

[Dudu2]

En y réfléchissant, c'est pas terminé ! Car on n'a traité que le cas d'une seule colonne.
Pour une ListBox multi-colonnes, la hauteur serait sujette au même traitement, mais il faudrait traiter la largeur des colonnes colonne par colonne sur le même principe (avec chacun sa méthode).
C'est faisable... mais plus tard !

 

[patricktoulon]

ho ben il y a un moyen simple pour ca
si je te dis
.list = tableau
tableau =range
range.column en autofit

tu vois ou je veux en venir

 

[patricktoulon]

comme ça mais vraiment vite fait

Private Sub UserForm_Click()
    Dim T, C&, W$
    T = Range("Tableau2").Value
    ListBox1.List = T
    With Cells(1, Columns.Count - UBound(T, 2)).Resize(UBound(T), UBound(T, 2))
        .Value = T
        .EntireColumn.AutoFit
        For C = 1 To .Columns.Count + 1
            W = W & .Cells(1, C).Width & ";"
        Next
        W = W & 0
        W = Replace(W, ".", ",")
        ListBox1.ColumnCount = UBound(T) + 1
        ListBox1.ColumnWidths = W
        ListBox1.Width = .Width + 3
        .EntireColumn.Delete


        'utilise ta fonction avec la colonne 1 du tableau
        ListBox1.Height = ((ListBox1.Font.Size + 1.6) * ListBox1.ListCount) + 3
    End With
End Sub

 

[Dudu2]

Après revue et intégration des ColumnHeads, et de colonnes multiples, voici les 2 fichiers (1 pour la ListBox ActiveX et 1 pour la ListBox UserForm) qui font le job de les ajuster en largeur et en hauteur avec une méthode simple, sûre et précise.

Ils fournissent les 2 fonctions dédiées qu'il suffit d'appeler avec les paramètres ad hoc:
- ValueAndSizeActiveXListBox()
- ValueAndSizeUserFromListBox()

 

[patricktoulon]

re
Bonjour @Dudu2
si tu veux faire un resize par rapport au font de la listbox avec un range
l’échelle n'est pas la même pour les activX et les range
je rajoute 1 au fontsize du range
regarde celui la le userform 2 et joue avec les boutons

 

[Dudu2]

Bonjour @patricktoulon,

Oui, j'ai remarqué que les Resize en ActiveX (en UserForm je n'ai pas encore vérifié) pouvaient n'être pas 100% corrects et ne pas permettre à la Scroll Bar d'atteindre le dernier item. Je suis dessus, par exemple pour de très grosses polices.

La solution c'est de passer le ListBox.IntegralHeight = True pour la réduction de hauteur, mais Excel réduit assez sensiblement la hauteur dans ce cas, trop je trouve. Du coup je rajoute aussi à la hauteur du Resize le Font.Size de la ListBox et miracle, ça resize quasi à la bonne hauteur avec une petite variante et + ou en - due au IntegralHeight.

Je vérifie et republierai ! One more time. C'est sans fin
Edit: C'est republié ci-dessus.
Edit: Le problème est le même en UserForm
Edit: J'ai appliqué la même logique au UserForm et republié ci-dessus.

 

[patricktoulon]

et ma version que donne t elle?

 

[Dudu2]

Un resize très grande police en ListBox ActiveX.

et ma version que donne t elle?

Oui, ça fonctionne.

 

[patricktoulon]

re
bilan des choses qui sont sures
REDIMENSIONNEMENT EN HAUTEUR

1° le redimensionnement en hauteur par un textbox en autosize avec les mêmes paramètres que la listbox
attention au specialffect et au borderstyle

2° nous soustrayons la valeur 3 correspondante a la constante de getsystemmetrics(36) (universelles)
qui correspondent a l'épaisseur de bordure créé avec le specialffect( de 1 à 6)
si les paramètres sont parfaitement synchrone le redimensionnement en hauteur est quasi parfait

REDIMENTTIONNEMENT EN LARGEUR
1°pour une colonne utiliser le width du textbox + la constante de getsystemmetrics(36) en l’occurrence 3
2° pour le multi colonne il sera préférable d'utiliser une plage de cellule dans le quel on retransfère le tableau ou le .list de la listbox et là on fait pareill pour les propriété font sauf que le size devra être à 1 de plus
pour être exact c'est 1.375 mais avec le rattrapage du DLGframe les nuances sont imperceptible a l’œil humain de l'ordre de 0.001 à 0.003 ce qui pour le vba avec les arrondi des calculs n'a quasiment pas d'incidence
la largeur des colonnes et de la listbox seront calquées ensuite sur la plage temporaire

pour info
la valeur 3(getsystemmetrics(36)) peut s'obtenir par le width-insidewidth de la listbox par l'intermédiaire d'un switch sur intergralheight et une mise a zero temporaire du height et récupération du height
ça reste une méthode versatile il arrive que chez moi la mise a zero ne s'opère et je me retrouve avec 16 qui est le height minimal en fonction du font.size d'une listbox ( donc a utiliser avec précautions )
comme c'est universelles j'utilise le nombre 3 variabilisé ou pas


voila les choses sont simples pas la peine d'en faire plus pour si peu

utilité de cette pratique
elle est rare
elle peut être utile par exemple pour une liste de choix positionnée sur un bouton (une sorte de menu contextuel (voir ressource patricktoulon à ce sujet)
elle peut être utile lors du redimensionnement d'un userform les paramètres seront au prorata du redimensionnement de l'userform et c'est valable pour l'inverse

conclusion:
en faire plus est du branlage de code

toutes les méthodes dans cette discussions (@job75 / @Dudu2 / @patricktoulon)

on été testées pour ma part sur:

• Office 2007 32 bit en VB sur Win 7
• Office 2013 32 bit pro en vba7 sur Win 10
• Office 2016 64 bits en vba 7 sur Win 10

 

[patricktoulon]

Ben le fichier je te l'ai renvoyé c'est dans le tiens en post #38
j'ai ajouter un bouton et un userform

 

[TWal]

Bonjour à vous 3,

les fichiers ne sont pas téléchargeables dans le post N°37.

Bonne journée

 

[Dudu2]

Bonjour @TWal,
Quand je clique dessus ça les télécharge.
Je ne vois pas pourquoi ça ne marcherait pas chez toi. Il suffit de cliquer.
Vérifie dans ton dossier de téléchargements.