XL 2010 Deux Listboxs Liées

cathodique

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
job75
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...
Trier par date Trier par votes
Dranreb

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é.
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
Dranreb à dit:
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é.
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
job75

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
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
job75 à dit:
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+
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
job75

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:
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
job75 à dit:
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.
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
job75

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
Vote positif 1 Vote négatif
Solution
cathodique

cathodique

XLDnaute Barbatruc
job75 à dit:
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+
Cliquez pour agrandir...
Pour moi c'est parfait. Avec tous mes remerciements.

Excellente journée.
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
Microsoft 365 - Conseils pour la structuration d'une base de données -
2 3
Réponses
44
Affichages
3 K
crocrocro
C
B
  • Question
XL 2019 Créer une passerelle entre deux champs différents ? ( Pour RechercheV)
Réponses
8
Affichages
1 K
Hasco
Hasco
M
  • Résolu(e)
Microsoft 365 Lier deux listes déroulantes entre-elles et à un même tableau.
2
Réponses
22
Affichages
3 K
Etoto
Etoto
N
  • Question
XL 2016 Copier des lignes d'une feuille à l'autre sur une même Excel par double clique
Réponses
0
Affichages
1 K
Ned2
N
A
  • Résolu(e)
XL 2019 Comparer 2 tableaux dans deux feuilles puis attribuer une valeur définie
Réponses
6
Affichages
3 K
Alketros
A
T
  • Question
Renvoyer une valeur à multivariable (indemnité km)
Réponses
4
Affichages
1 K
teuch
T
A
  • Question
Autres VBA extraire donnée entre deux dates
Réponses
8
Affichages
3 K
akira21
A
L
  • Question
aide creation planning
Réponses
11
Affichages
2 K
le tophe
L
M
  • Question
XL 2013 VBA - comparer les valeur des cellules dans deux colonnes différentes et colorier si différent
Réponses
1
Affichages
2 K
Jacky67
Jacky67
P
  • Question
Drag and Drop entre deux listboxs + lien avec une troisième
Réponses
14
Affichages
1 K
pumbathekings
P

Membres actuellement en ligne

1 membres et 40 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 098
Messages
2 116 189
Membres
112 679
dernier inscrit
Yupanki