Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autres dimensionner une listbox pour DUDU2

patricktoulon

XLDnaute Barbatruc
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

XLDnaute Barbatruc
je l'ai intégrer dans ma méthode aussi
du coup j'ai même la hauteur d'un item
VB:
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
 

patricktoulon

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
comme ça mais vraiment vite fait
VB:
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

XLDnaute Barbatruc

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()
 

Pièces jointes

  • ValueAndSizeActiveXListBox.xlsm
    357.4 KB · Affichages: 3
  • ValueAndSizeUserFormListBox.xlsm
    72.2 KB · Affichages: 2

patricktoulon

XLDnaute Barbatruc
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
 

Pièces jointes

  • ValueAndSizeUserFormListBox(6).xlsm
    51.2 KB · Affichages: 4

Dudu2

XLDnaute Barbatruc
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.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…