Bug listbox avec la propriété list

Question

Je ne comprends pas le bug de ce message. Voilà le fichier. Pour reproduire l'erreur, il faut Ouvrir le formulaire par double clic Sélectionner FORD en marque et Focus en modèle. Merci...

LouReeD · Accepted Answer

Bravo à vous d'avoir assimiler le principe ! @ bientôt LouReeD...

LouReeD · Answer

En remplissage "individuel" il n'est pas possible d'aller au delà de 9 colonnes, ou du moins au delà d'index 9 de la listbox. Il vous faut passer par un tableau et ensuite injecter le tableau dans la list. @ bientôt LouReeD...

LouReeD · Answer

Une proposition de code :

Private Sub modl_Change()
'Filtre les véhicules sur la marque et le modéle
    Dim i%, j%, ws1 As Worksheet, tb1 As ListObject, MonTab(0 To 11)
    Application.ScreenUpdating = False
    Set ws1 = Sheets("Parc")
    Set tb1 = ws1.ListObjects("Park")
    'efface liste precedente
    Me.imats2.Clear
    Me.imats2.Visible = False
    'liste
    For i = 1 To tb1.ListRows.Count
    'si marq et modele, alors en liste
        If tb1.DataBodyRange(i, 2).Value = Me.marq.Value And tb1.DataBodyRange(i, 3).Value = Me.modl.Value Then
' MsgBox CSng(tb1.DataBodyRange(i, 11).Value): GoTo fin
            MonTab(0) = tb1.DataBodyRange(i, 1).Value 'immat
            MonTab(1) = tb1.DataBodyRange(i, 2).Value 'marque
            MonTab(2) = tb1.DataBodyRange(i, 3).Value 'modele
            MonTab(3) = tb1.DataBodyRange(i, 4).Value  'couleur
            MonTab(4) = tb1.DataBodyRange(i, 6).Value 'type veh
            MonTab(5) = tb1.DataBodyRange(i, 7).Value 'nb places
            MonTab(6) = tb1.DataBodyRange(i, 8).Value  'Bte Vtesse
            MonTab(7) = tb1.DataBodyRange(i, 9).Value 'carburant
            MonTab(8) = tb1.DataBodyRange(i, 10).Value 'fonction/sce
            MonTab(9) = tb1.DataBodyRange(i, 5).Value 'Mise en sce
            MonTab(10) = tb1.DataBodyRange(i, 11).Value 'CV
            MonTab(11) = tb1.DataBodyRange(i, 12).Value 'PTAC
            Me.imats2.Column() = MonTab
        End If
    Next i
        If Me.imats2.ListCount <> 0 Then
            Me.imats2.Visible = True
            Me.imats2.ColumnWidths = "50;50;50;50;50;20;40;50;50;50;20;30" 'largeur cols listbox
        End If
fin:
    Application.ScreenUpdating = True
End Sub

@ bientôt

LouReeD

LouReeD · Answer

Attendons alors ! @ bientôt LouReeD...

LouReeD · Answer

Comme je vous l'ai annoncé, pour aller au delà d e9 item il faut bien injecter les données par l'intermédiaire d'un tableau. merci de votre retour et remerciement. @ bientôt LouReeD...

LouReeD · Answer

*il faut donc répéter deux fois la chose ou bien créer un tableau à deux dimensions, une pour les colonnes et l'autre pour les lignes et ensuite injection ! @ bientôt LouReeD...

LouReeD · Answer

Un essai non essayé : Me.imats2.List = tablo() Me.imats2.Height = 10 * x ' 10 correspond à la hauteur d'une ligne à étudier Si la listebox est plus grande que le nombre de lignes alors il n'y a pas de scrollbarre, donc à vous de faire en sorte qu'elle soit plus grande d'une ligne sans pour autant dépasser une certaine hauteur afin de rester gérable dans votre USF. @ bientôt LouReeD...

LouReeD · Answer

J'ai modifié le code afin de faire un ReDim Preserve sur le Tablo, pour qu'il s'ajuste aux données récupérées, Il se retrouve inversé, c'est pourquoi l'injection se fait avec Application.Transpose. Ensuite je défini une hauteur de ListBox en fonction du nombre de données, je n'ai pas mis le test de hauteur maximum de cette liste : Private Sub modl_Change() 'Filtre les véhicules sur la marque et le modéle Dim i%, x%, ws1 As Worksheet, tb1 As ListObject, tablo() Application.ScreenUpdating = False Set ws1 = Sheets("Parc") Set tb1 = ws1.ListObjects("Park") x = 0 ReDim tablo(0 To 11, 0 To x) 'efface liste precedente Me.imats2.Clear For i = 1 To tb1.ListRows.Count 'si marq et modele, alors en liste (limitée à 10 cols) donc onpasse par un tablo If tb1.DataBodyRange(i, 2).Value = Me.marq.Value And IsNumeric(tb1.DataBodyRange(i, 3).Value) Then If tb1.DataBodyRange(i, 3).Value = CSng(Me.modl.Value) Then tablo(0, x) = tb1.DataBodyRange(i, 1).Value 'immat tablo(1, x) = tb1.DataBodyRange(i, 2).Value 'marque tablo(2, x) = CSng(tb1.DataBodyRange(i, 3).Value) 'modele tablo(3, x) = tb1.DataBodyRange(i, 4).Value 'couleur tablo(4, x) = tb1.DataBodyRange(i, 6).Value 'type veh tablo(5, x) = tb1.DataBodyRange(i, 7).Value 'nb places tablo(6, x) = tb1.DataBodyRange(i, 8).Value 'Bte Vtesse tablo(7, x) = tb1.DataBodyRange(i, 9).Value 'carburant tablo(8, x) = tb1.DataBodyRange(i, 10).Value 'fonction/sce tablo(9, x) = tb1.DataBodyRange(i, 5).Value 'Mise en sce tablo(10, x) = tb1.DataBodyRange(i, 9).Value 'kit ML x = x + 1 ReDim Preserve tablo(0 To 11, 0 To x) End If End If Next i Me.imats2.List = Application.Transpose(tablo()) Me.imats2.Height = (x + 1) * 10 + 10 ' à voir ce que cela donne s'il y a plus de lignes à afficher If Me.imats2.ListCount &lt;&gt; 0 Then Me.imats2.ColumnWidths = "50;50;50;50;50;40;40;70;70;55;30;30;30" 'largeur cols listbox End If fin: Application.ScreenUpdating = True End Sub @ bientôt LouReeD...

LouReeD · Answer

Test de hauteur maxi : If (x + 1) * 10 &lt; 132.5 Then Me.imats2.Height = (x + 1) * 10 + 10 Si le nombre de ligne ne dépasse pas la hauteur maxi alors on les affiches avec une marche ce qui n'affiche pas la scrollbarre, sinon on fait rien et c'est VBA et Excel qui gèrent... @ bientôt LouReeD...

LouReeD · Answer

Lorsque vous êtes en conception, clic sur la listebox, puis sur la droite propriété Height : 132.5

Chez moi le code fonctionne...

en ajoutant +10 à la ligne vous créez alors un blanc sous les données et la scrollbarre devrait disparaitre.

@ bientôt

LouReeD

LouReeD · Answer

Merci pour le retour ! @ bientôt LouReeD...