XL 2010 Deux Listboxs Liées

cathodique

XLDnaute Barbatruc
Bonjour,

Je sais que la présente discussion va interpeller @Dranreb qui a fait un gros travail pour des comboboxs liées.
Ma demande concerne 2 listboxs liées, j'explique:
Sur la feuille Fa se trouve des renseignements concernant l'animal. Sur la feuille Fp, coordonnées de la personne ayant cédée l'animal. Et, sur la feuille F_Lien, son nom est assez explicite. Elle relie les 2 tableaux par le No_Dossier, Id_Animal et Id_Person.

Dans le formulaire 2 litsboxs, une affichant le tableau de la feuille Fa et l'autre Le tableau de la feuille Fp.
Je voudrais qu'en faisant un choix dans une des 2 listboxs que dans l'autre la ligne correspondante soit sélectionnée.
En d'autres termes, faire des listboxs liées, en allant trouver la correspondance dans le tableau "TbLiaison".

J'ai commencé à la faire un truc mais je me suis perdu. Mon code tourne sans fin (procédure "Choix_Listbox") ou plante.

Merci pour votre aide.

Bonne journée.
 

Pièces jointes

  • ListBoxs_Liées.xlsm
    34.7 KB · Affichages: 6
Solution
Bonjour cathodique, le forum,

Pour cadrer il faut utiliser la propriété TopIndex des ListBox :
VB:
Private Sub ListBoxIdAnimal_Change()
If flag Then Exit Sub
flag = True
Dim i&, ID As Variant
For i = 0 To ListBoxPerson.ListCount - 1
    ListBoxPerson.Selected(i) = False
Next i
ID = Application.VLookup(ListBoxIdAnimal.List(ListBoxIdAnimal.ListIndex, 0), [TbLiaison].Columns(2).Resize(, 3), 3, 0)
ListBoxPerson.TopIndex = 0
If Not IsError(ID) Then
    For i = 0 To ListBoxPerson.ListCount - 1
        If ListBoxPerson.List(i, 0) = ID Then ListBoxPerson.Selected(i) = True: ListBoxPerson.TopIndex = i: Exit For
    Next i
End If
flag = False
End Sub

Private Sub ListBoxPerson_Change()
If flag Then Exit Sub
flag = True
Dim i&, ID, c As Range...

Dranreb

XLDnaute Barbatruc
Bonjour.
Je n'ai pas créé d'objet ListBoxLiées. Mais j'ai dans le module MSujetCBx une Function TLgnLBx qui renvoie une liste de numéros de lignes à partir d'une ListBox et d'un Sujet établi préalablement par la fonction SujetCBx. Or une méthode FiltrerLignes de l'objet ComboBoxLiées peut en tirer partie. Mais ça n'a peut être jamais été utilisé.
 

cathodique

XLDnaute Barbatruc
Bonjour.
Je n'ai pas créé d'objet ListBoxLiées. Mais j'ai dans le module MSujetCBx une Function TLgnLBx qui renvoie une liste de numéros de lignes à partir d'une ListBox et d'un Sujet établi préalablement par la fonction SujetCBx. Or une méthode FiltrerLignes de l'objet ComboBoxLiées peut en tirer partie. Mais ça n'a peut être jamais été utilisé.
Bonjour,

Je te remercie. Je ne sais pas si tu as bien compris ma demande et remarquer que mon fichier est constitué de 3 tables dont l'une fait la liaison entre les 2 autres. Est-ce que ta fonction résoudra mon problème?

J'espère que je serai très clair:

Le tableau de la feuille Fa (a pour animal) est affiché dans une listbox, il y un numéro de dossier et un Identifiant (sans doublon possible, ne figurant pas dans le tableau de la feuille Fp).

Le tableau de la feuille Fp (p pour personne) est affiché dans une seconde listbox, il y a un identifiant (sans doublon possible, ne figurant pas dans le tableau de la feuille Fp).

Cependant, le 3ème tableau fait la liaison entre les 2 tableaux.

Process possibles:

1 - Choix dans la 1ère listbox, on recherche le n° de dossier dans le tableau de liaison pour récupérer l'id de la personne. Puis on recherche cet id dans la seconde listbox pour le selectionner.

ou

2 - Choix dans la 2ème listbox, on recherche l'id personne dans le tableau de liaison pour récupérer le n° de dossier. Puis on recherche ce numéro dans la première listbox pour le selectionner.

Un peu tordu, mais c'est mon besoin actuel.

Encore merci.

Bonne journée.
 

job75

XLDnaute Barbatruc
Bonjour cathodique, Bernard,

Voyez le fichier joint et ces 2 macros dans le code de l'UserForm :
VB:
Private Sub ListBoxIdAnimal_Click()
Static flag As Boolean
If flag Then Exit Sub
flag = True
Dim i&, ID As Variant
For i = 0 To ListBoxPerson.ListCount - 1
    ListBoxPerson.Selected(i) = False
Next i
ID = Application.VLookup(ListBoxIdAnimal, [TbLiaison].Columns(2).Resize(, 3), 3, 0)
If Not IsError(ID) Then
    For i = 0 To ListBoxPerson.ListCount - 1
        If ListBoxPerson.List(i, 0) = ID Then ListBoxPerson.Selected(i) = True: Exit For
    Next i
End If
flag = False
End Sub

Private Sub ListBoxPerson_Click()
Static flag As Boolean
If flag Then Exit Sub
flag = True
Dim i As Variant, dossier$
For i = 0 To ListBoxIdAnimal.ListCount - 1
    ListBoxIdAnimal.Selected(i) = False
Next i
i = Application.Match(ListBoxPerson, [TbLiaison].Columns(4), 0)
If IsNumeric(i) Then
    dossier = [TbLiaison].Cells(i, 2)
    For i = 0 To ListBoxIdAnimal.ListCount - 1
        If ListBoxIdAnimal.List(i, 0) = dossier Then ListBoxIdAnimal.Selected(i) = True: Exit For
    Next i
End If
flag = False
End Sub
La variable flag évite un bouclage sans fin.

A+
 

Pièces jointes

  • ListBoxs_Liées(1).xlsm
    34.9 KB · Affichages: 4

cathodique

XLDnaute Barbatruc
Bonjour cathodique, Bernard,

Voyez le fichier joint et ces 2 macros dans le code de l'UserForm :
VB:
Private Sub ListBoxIdAnimal_Click()
Static flag As Boolean
If flag Then Exit Sub
flag = True
Dim i&, ID As Variant
For i = 0 To ListBoxPerson.ListCount - 1
    ListBoxPerson.Selected(i) = False
Next i
ID = Application.VLookup(ListBoxIdAnimal, [TbLiaison].Columns(2).Resize(, 3), 3, 0)
If Not IsError(ID) Then
    For i = 0 To ListBoxPerson.ListCount - 1
        If ListBoxPerson.List(i, 0) = ID Then ListBoxPerson.Selected(i) = True: Exit For
    Next i
End If
flag = False
End Sub

Private Sub ListBoxPerson_Click()
Static flag As Boolean
If flag Then Exit Sub
flag = True
Dim i As Variant, dossier$
For i = 0 To ListBoxIdAnimal.ListCount - 1
    ListBoxIdAnimal.Selected(i) = False
Next i
i = Application.Match(ListBoxPerson, [TbLiaison].Columns(4), 0)
If IsNumeric(i) Then
    dossier = [TbLiaison].Cells(i, 2)
    For i = 0 To ListBoxIdAnimal.ListCount - 1
        If ListBoxIdAnimal.List(i, 0) = dossier Then ListBoxIdAnimal.Selected(i) = True: Exit For
    Next i
End If
flag = False
End Sub
La variable flag évite un bouclage sans fin.

A+
Bonsoir @job75 ;),

Je te remercie pour ton aide.
C'est déjà un grand pas de ne plus avoir de boucle sans fin.
Lorsque l'on clique dans la listbox identification animal, il n'y a pas de doublon. Donc une ligne sélectionnée implique une seule ligne de sélectionner dans la liste personne.

Mais si on clique dans la listbox identification personne, la personne peut avoir plusieurs animaux (soient plusieurs lignes à sélectionner).

Autrement dit, un animal ne peut être que chez une seule personne. Mais une personne peut avoir plusieurs animaux.
ex: la personne P000001 est en charge de 3 animaux:
2020060 - 250 269 590 096 813
2022106 - 250 269 590 349 067
2022109 - 250 269 590 342 584

Actuellement, au choix de la personne P000001, seule la 1ere ligne est sélectionnée (soit 2020060).
C'est déjà un début très encourageant.

Encore merci.

Bonne soirée.
 

job75

XLDnaute Barbatruc
J'ai mis la propriété MultiSelect de ListBoxIdAnimal sur fmMultiSelectExtended.

Le code modifié :
VB:
Dim flag As Boolean 'mémorise la variable
'---

Private Sub ListBoxIdAnimal_Change()
If flag Then Exit Sub
flag = True
Dim i&, ID As Variant
For i = 0 To ListBoxPerson.ListCount - 1
    ListBoxPerson.Selected(i) = False
Next i
ID = Application.VLookup(ListBoxIdAnimal.List(ListBoxIdAnimal.ListIndex, 0), [TbLiaison].Columns(2).Resize(, 3), 3, 0)
If Not IsError(ID) Then
    For i = 0 To ListBoxPerson.ListCount - 1
        If ListBoxPerson.List(i, 0) = ID Then ListBoxPerson.Selected(i) = True: Exit For
    Next i
End If
flag = False
End Sub

Private Sub ListBoxPerson_Change()
If flag Then Exit Sub
flag = True
Dim i&, ID, c As Range, dossier$
For i = 0 To ListBoxIdAnimal.ListCount - 1
    ListBoxIdAnimal.Selected(i) = False
Next i
ID = ListBoxPerson
For Each c In [TbLiaison].Columns(4).Cells
    If c = ID Then
        dossier = CStr(c(1, -1))
        For i = 0 To ListBoxIdAnimal.ListCount - 1
            If ListBoxIdAnimal.List(i, 0) = dossier Then ListBoxIdAnimal.Selected(i) = True: Exit For
        Next i
    End If
Next c
flag = False
End Sub
Bonne nuit.
 

Pièces jointes

  • ListBoxs_Liées(2).xlsm
    36.5 KB · Affichages: 3
Dernière édition:

cathodique

XLDnaute Barbatruc
J'ai mis la propriété MultiSelect de ListBoxIdAnimal sur fmMultiSelectExtended.

Le code modifié :
VB:
Dim flag As Boolean 'mémorise la variable
'---

Private Sub ListBoxIdAnimal_Change()
If flag Then Exit Sub
flag = True
Dim i&, ID As Variant
For i = 0 To ListBoxPerson.ListCount - 1
    ListBoxPerson.Selected(i) = False
Next i
ID = Application.VLookup(ListBoxIdAnimal.List(ListBoxIdAnimal.ListIndex, 0), [TbLiaison].Columns(2).Resize(, 3), 3, 0)
If Not IsError(ID) Then
    For i = 0 To ListBoxPerson.ListCount - 1
        If ListBoxPerson.List(i, 0) = ID Then ListBoxPerson.Selected(i) = True: Exit For
    Next i
End If
flag = False
End Sub

Private Sub ListBoxPerson_Change()
If flag Then Exit Sub
flag = True
Dim i&, ID, c As Range, dossier$
For i = 0 To ListBoxIdAnimal.ListCount - 1
    ListBoxIdAnimal.Selected(i) = False
Next i
ID = ListBoxPerson
For Each c In [TbLiaison].Columns(4).Cells
    If c = ID Then
        dossier = CStr(c(1, -1))
        For i = 0 To ListBoxIdAnimal.ListCount - 1
            If ListBoxIdAnimal.List(i, 0) = dossier Then ListBoxIdAnimal.Selected(i) = True: Exit For
        Next i
    End If
Next c
flag = False
End Sub
Bonne nuit.
Bonjour @job75 ,

Et pourtant, c'est ce que j'ai fait sur ton fichier du post#6.
J'ai un petit écran, je n'ai sûrement pas bien regardé ou défiler vers le bas pour rendre visible les lignes sélectionnées.
Sur ton dernier fichier, c'est parfait. Je t"en remercie. Je vais pouvoir avancer.
Une dernière question, stp comment faire remonter vers le haut de la listbox les lignes sélectionnées.
C'est bien plus pratique que de défiler pour visualiser les lignes. Surtout qu'il va y avoir un très grand nombre de lignes.

Encore merci.

Bonne journée.
 

job75

XLDnaute Barbatruc
Bonjour cathodique, le forum,

Pour cadrer il faut utiliser la propriété TopIndex des ListBox :
VB:
Private Sub ListBoxIdAnimal_Change()
If flag Then Exit Sub
flag = True
Dim i&, ID As Variant
For i = 0 To ListBoxPerson.ListCount - 1
    ListBoxPerson.Selected(i) = False
Next i
ID = Application.VLookup(ListBoxIdAnimal.List(ListBoxIdAnimal.ListIndex, 0), [TbLiaison].Columns(2).Resize(, 3), 3, 0)
ListBoxPerson.TopIndex = 0
If Not IsError(ID) Then
    For i = 0 To ListBoxPerson.ListCount - 1
        If ListBoxPerson.List(i, 0) = ID Then ListBoxPerson.Selected(i) = True: ListBoxPerson.TopIndex = i: Exit For
    Next i
End If
flag = False
End Sub

Private Sub ListBoxPerson_Change()
If flag Then Exit Sub
flag = True
Dim i&, ID, c As Range, dossier$, cadre As Boolean
For i = 0 To ListBoxIdAnimal.ListCount - 1
    ListBoxIdAnimal.Selected(i) = False
Next i
ID = ListBoxPerson
ListBoxIdAnimal.TopIndex = 0
For Each c In [TbLiaison].Columns(4).Cells
    If c = ID Then
        dossier = CStr(c(1, -1))
        For i = 0 To ListBoxIdAnimal.ListCount - 1
            If ListBoxIdAnimal.List(i, 0) = dossier Then
                ListBoxIdAnimal.Selected(i) = True
                If Not cadre Then cadre = True: ListBoxIdAnimal.TopIndex = i
                Exit For
            End If
        Next i
    End If
Next c
flag = False
End Sub
A+
 

Pièces jointes

  • ListBoxs_Liées(3).xlsm
    37 KB · Affichages: 5

cathodique

XLDnaute Barbatruc
Bonjour cathodique, le forum,

Pour cadrer il faut utiliser la propriété TopIndex des ListBox :
VB:
Private Sub ListBoxIdAnimal_Change()
If flag Then Exit Sub
flag = True
Dim i&, ID As Variant
For i = 0 To ListBoxPerson.ListCount - 1
    ListBoxPerson.Selected(i) = False
Next i
ID = Application.VLookup(ListBoxIdAnimal.List(ListBoxIdAnimal.ListIndex, 0), [TbLiaison].Columns(2).Resize(, 3), 3, 0)
ListBoxPerson.TopIndex = 0
If Not IsError(ID) Then
    For i = 0 To ListBoxPerson.ListCount - 1
        If ListBoxPerson.List(i, 0) = ID Then ListBoxPerson.Selected(i) = True: ListBoxPerson.TopIndex = i: Exit For
    Next i
End If
flag = False
End Sub

Private Sub ListBoxPerson_Change()
If flag Then Exit Sub
flag = True
Dim i&, ID, c As Range, dossier$, cadre As Boolean
For i = 0 To ListBoxIdAnimal.ListCount - 1
    ListBoxIdAnimal.Selected(i) = False
Next i
ID = ListBoxPerson
ListBoxIdAnimal.TopIndex = 0
For Each c In [TbLiaison].Columns(4).Cells
    If c = ID Then
        dossier = CStr(c(1, -1))
        For i = 0 To ListBoxIdAnimal.ListCount - 1
            If ListBoxIdAnimal.List(i, 0) = dossier Then
                ListBoxIdAnimal.Selected(i) = True
                If Not cadre Then cadre = True: ListBoxIdAnimal.TopIndex = i
                Exit For
            End If
        Next i
    End If
Next c
flag = False
End Sub
A+
Pour moi c'est parfait. Avec tous mes remerciements.

Excellente journée.
 

Discussions similaires

Statistiques des forums

Discussions
313 204
Messages
2 096 206
Membres
106 528
dernier inscrit
Sabrnajean