Filtrer une listbox déjà remplie avec une Combobox

Re,

Pas de retour sur mon dernier post. Je suppose que cela fonctionne ?? ...

Voici le code à ajouter pour remplir la listbox 2 en fonction de la valeur choisie dans la combobox

Private Sub ComboBox1_Change()
Dim tb As ListObject
Dim c As Range
Dim prem As String
Dim i As Byte, j
Dim nbart As Integer
Dim tablo()

Me.LB_Liste_Contact.Clear
Call efface
If Me.ComboBox1.ListIndex = -1 Then Exit Sub 'edit

Set tb = f2.ListObjects(1)

Set c = tb.ListColumns(1).Range.Find(Me.DESIGNATION.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

    prem = c.Address
    nbart = WorksheetFunction.CountIfs(tb.ListColumns(1).DataBodyRange, DESIGNATION.Value, tb.ListColumns(2).DataBodyRange, ComboBox1.Value)
    ReDim tablo(nbart - 1, tb.ListColumns.Count - 5) As Variant

    Do
        If c.Offset(0, 1).Value = Me.ComboBox1.Value Then

            For i = 5 To tb.ListColumns.Count
                tablo(j, i - 5) = tb.DataBodyRange.item(c.Row - 1, i).Value
            Next i
            j = j + 1
            Me.LB_Liste_Contact.List = tablo

        End If
        Set c = tb.ListColumns(1).DataBodyRange.FindNext(c)
    Loop While Not c Is Nothing And c.Address <> prem

End If
End Sub

Faites un test pour voir si ok avant de passer à la suite

Autre point : est-ce que vous ne devriez pas mettre la propriété LOCKED de la textbox Designation à TRUE. Cela éviterait d'aller modifier la donnée qui vient du choix dans la listbox1

Re,

désolé, j'ai du m'absenter un moment.

Pour la propriété de la textbox désignation sur "Locked = True", c'est une bonne idée. Je l'ai fait.

Pour le code, c'est ok, j'ai juste dû ajouter une variable pour "fournisseur"

2023 04 24 180745

Par contre, mes label et Textbox ne fonctionnent plus pour les détails.

2023 04 24 181824

Pas de soucis

Pour le code, quand je sélecionne une ligne de la deuxième ListBox "LB_Liste_Contact", j'ai une erreur dans le code qui dit "Erreur de compilation : Variable non définie"

Vous allez trop vite là .... votre code n'est plus bon.

Voici celui à utiliser :

Private Sub LB_Liste_Contact_Click()
Dim i As Byte

If Me.LB_Liste_Contact.ListIndex = -1 Then Exit Sub
Call efface

ligArt = Me.LB_Liste_Contact.List(Me.LB_Liste_Contact.ListIndex, 13)

With Me
    REF = f2.ListObjects(1).DataBodyRange(ligArt - 1, 3)
    TB_Nom_Contact = f2.ListObjects(1).DataBodyRange(ligArt - 1, 4)

    For i = 0 To Me.LB_Liste_Contact.ColumnCount - 1
        .Controls("Textbox" & i + 50) = .LB_Liste_Contact.List(Me.LB_Liste_Contact.ListIndex, i)
    Next i
End With
End Sub

Pardon c'est vrai que je suis allé trop vite.

ça fonctionne. Il reste encore les label qui doivent s'adapter selon le text de ma feuille "BD"

Alors j'ai pu tout tester, c'est tip top nickel. ça fonctionne parfaitement.

Encore merci pour le temps passé pour moi et au plaisir.

Pas de soucis.

Reste la textbox Rechercher si elle doit rester dans votre USF

Mais là je dois comprendre le pourquoi et son utilisation.
Si elle n'a pas de raison d'être il faudra supprimer quelques lignes dans le code Initialize

Je ne sais pas encore si je vais la retirer. Pour le moment la liste est courte, mais elle risque de s' agrandir.

Bonjour,

Dans le code Combo_change que je vous ai donné dans ce post https://forum.excel-pratique.com/s/goto/1137915, il vous faut ajouter la ligne ci-dessous juste après l'instruction Call Efface.

If Me.ComboBox1.ListIndex = -1 Then Exit Sub

NB : je l'ai aussi rajouté dans le code posté sur le lien ci-dessus avec un mention "Edit" juste en fin de ligne


Je ne sais pas encore si je vais la retirer.

Dites moi, car je vous ai préparé le code à placer pour cette textbox.

Bonjour,
Merci pour le code.
Je pense que je vais garder la Textbox pour la recherche, c'est toujours utile.

Parcontre, je n'arrive pas a renommer mes label selon la feuil "BD". Avez-vous une solution ?

2023 04 25 131354

Je pense que je vais garder la Textbox pour la recherche, c'est toujours utile.

Faites ceci :

1. Sub initialize : Supprimez ou désactivez la partie entre la ligne pointillée (là où j'ai indiqué "sera peut être remplacée plus tard") et le END SUB
2. Déclaration variables en haut des codes
: Supprimez ou désactivez --> DIM CHOIX()
3. TB_Recherche
: Remplacez votre code actuel par celui ci-dessous

Private Sub TB_Recherche_change()
'Macro Dan
Dim prem
Dim i As Byte
Dim c As Range
Dim tb As ListObject

Me.LB_Liste_ST.Clear

If Me.TB_Recherche = vbNullString Then
    ComboBox1.Clear
    Me.LB_Liste_ST.List = f1.ListObjects(1).DataBodyRange.Value
    Exit Sub
End If

If Me.TB_Recherche <> vbNullString Then
    Set tb = f1.ListObjects(1)

    With tb
        Set c = .ListColumns(1).DataBodyRange.Find("*" & Me.TB_Recherche.Value & "*", LookIn:=xlValues)
            If Not c Is Nothing Then
                prem = c.Address
                i = 0
                Do
                    Me.LB_Liste_ST.AddItem
                    Me.LB_Liste_ST.List(i, 0) = .DataBodyRange(c.Row, 1).Value
                    Set c = .ListColumns(1).DataBodyRange.FindNext(c)
                    i = i + 1
                Loop While Not c Is Nothing And c.Address <> prem
            End If
    End With
End If
Set c = Nothing
End Sub

Pour le test, mettez 1 lettre ou plusieurs, le code vous renverra la liste trouvée en listbox1. Si vous supprimez tout dans la textbox, le code vous remettra votre listbox avec toutes les données


Parcontre, je n'arrive pas a renommer mes label selon la feuil "BD". Avez-vous une solution ?

Heu..je n'ai pas compris là... Pour renommer vous devez le faire dans l'USF en sélectionnant chaque label.
Vous vouliez faire cela automatiquement ?? si oui, sur quel principe de fonctionnement

Nickel, le code est parfait !!!

Pour les label, c'est changer la "Caption" en fonction du choix dans la liste 2 de la feuille "BD". Les traiter comme si c'était une TextBox

Pour les label, c'est changer la "Caption" en fonction du choix dans la liste 2 de la feuille "BD"

De la liste 2 ?? dans la feuille BD c'est la liste 1 non ?
Mettons que Designation mentionne "Vis réglable", le label 50 et 51 (pour l'exemple) doivent avoir quelle info ?

les infos doivent être : matière, A, B, C.etc

Ça correspond aux dimensions sur les images (qui ne sont pas encore actives)

les infos doivent être : matière, A, B, C.etc

mais c'est depuis la listbox1 donc cela et pas la listbox 2 dont les données viennent de la feuille Détails

Si j'ai compris, essayez ceci :

1. Private Sub LB_Liste_ST_Click() : Ajoutez cette ligne au début du code juste en dessous de Me.designation.value=...

Call renommer

2. Ajoutez ce code dans l'USF

Private Sub renommer()
Dim tb As ListObject
Dim lig As Integer
Dim i As Byte

Set tb = f1.ListObjects(1)

On Error Resume Next
lig = WorksheetFunction.Match(Me.DESIGNATION.Value, tb.ListColumns(1).DataBodyRange, 0)
If lig = 0 Then MsgBox "Article" & Me.DESIGNATION.Value & " inexistant en feuille " & f1.Name: Exit Sub
On Error GoTo 0

For i = 50 To 62
    Me.Controls("Label" & i) = tb.DataBodyRange(lig, i - 47)
Next i
End Sub

Tant que l'on y est, dans votre fichier j'ai vu un code Private Sub TB_Recherche_DblClick. Remplacez le par celui ci-dessous

Private Sub TB_Recherche_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With Me
    .TB_Recherche = vbNullString
    .DESIGNATION = vbNullString
End With
End sub

En faisant un double click dans la TB_Recherche, cela videra la textbox.

Crdlt

Oui, en effet, je me suis trompé dans mes ListBox. Vous avez raison, c'est la 1ère.

Tout ce que vous m'avez fait fonctionne a merveille. Encore mille mercis pour le travail et le temps consacré pour moi.

Parfait !

Rechercher des sujets similaires à "filtrer listbox deja remplie combobox"