Listbox dépendantes en VBA

Version imprimable

Bonjour à tous.

Je ne trouve pas, malgré de multiples recherches et essais, la solution à un problème qui doit pourtant pas être si compliquée que ça :

Dans un Userform, j'ai plusieurs listboxs qui sont alimentées chacune par une colonne d'une feuille (sous excel97).

Je voudrais pouvoir réactualiser une listbox en fonction des valeurs selectionnées par l'utilisateur dans les listbox précédentes.

Par exemple, la listbox1 contient le nom d'entreprises clientes et la listbox2 le nom des collaborateurs. Je voudrais, lorsque l'utilisateur selectionne une ou plusieurs entreprises dans listbox1, que listbox2 n'ait comme entrées que les collaborateurs correspondants à ces entreprises.

Les entreprises sont dans la colonne D et les collaborateurs dans la colonne E, et toutes les colonnes contiennent des données à partir de la ligne 10.

J'ai donc une fonction pour alimenter une listbox (qui m'a été donnée par Qwaz :ave:, parce que là aussi je peinais comme un galérien) :
EDIT : me suis gouré, j'avais trouvé le code je sais plus où sur le net, mais Qwaz et Laetitia m'avaient vraiment beaucoup aidé.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 'alimente une listbox lst à partir d'une plage Target de la feuil1 (nom = "BASE") Private Sub AlimList(lst As Object, ByVal Target As Excel.Range) Dim tablo As Variant, Tempo As Variant, i As Long, j As Long Worksheets("BASE").Activate 'à défaut d'instancier la feuille tablo = Target.Value 'triAlpha For i = 1 To UBound(tablo) For j = 1 To UBound(tablo) If tablo(i, 1) < tablo(j, 1) Then Tempo = tablo(i, 1) tablo(i, 1) = tablo(j, 1) tablo(j, 1) = Tempo End If Next j Next i 'Remplissage excluant les doublons lst.AddItem tablo(1, 1) For i = 2 To UBound(tablo) If tablo(i, 1) <> tablo(i - 1, 1) Then lst.AddItem tablo(i, 1) Next lst.ListIndex = -1 End Sub
J'ai essayé de créer plusieurs fonctions usant de différentes stratégies telles que :

- récupérer les numéros des lignes comportant les valeurs 'clés' de listbox1 pour ensuite récupérer les valeurs à mettre dans listbox2 => pas réussi :aie:

- même chose avec les coordonnées des cellules => pas réussi :aie:

A chaque fois j'ai essayé de stocker les coordonnées de plusieurs façons différentes : tableau, range (via Union), collections, etc ...
Pareil pour le "décalage" des coordonnées (pour passer de la colonne E à la D), j'ai essayé en modifiant les strings des coordonnées, en utilisant Offset, ...

Je dois juste être trop mauvais. :oops: J'ai commencé le VBA y'a une semaine pour mon stage.

Auriez-vous des pistes, ou encore mieux, des codes ? J'ai beau essayer de trouver d'autres moyens, là je cale. :(

Je vous mets pas mes codes pour pas vous influencer, si vous les voulez y'a qu'à demander (je les ai pas tous gardés par contre :?).

Merci d'avance.

Je continue d'essayer, j'en arrive à la fonction suivante :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
'fonction qui retourne un range contenant les cellules correspondantes à
'celles de plageRecherche qui contiennent valeurCherchee.
'decal sert pour la fonction offset
 
Public Function plageValeur(ByVal valeurCherchee As String, ByVal plageRecherche As Range, ByVal decal As Integer) As Range
 
Dim maCell As Range
 
For Each maCell In plageRecherche.Cells
    If maCell.Value = valeurCherchee Then
 
        If plageValeur Is Nothing Then
            Set plageValeur = maCell.Offset(, decal)
        Else
            Set plageValeur = Application.Union(plageValeur, maCell.Offset(, decal))
        End If
    End If
 
Next maCell
 
 
End Function

Et voici l'initialize dans lequel je teste l'appel avec la valeur BBF (qui existe bien dans la colonne D):

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub UserForm_Initialize()
 
    Dim tstPlag As Excel.Range
    With Sheets(1)
 
    Set tstPlag = plageValeur("BBF", Range("D10:D" & Range("D" & Rows.Count).End(xlUp).Row), 1)
 
    'Pour une raison inconnue,
    'AlimList ne marche pas sur la listbox concernée par le premier appel
    'donc le premier appel est fait sur une box cachée (listbox5) qui sert de poubelle à bug
        AlimList ListBox5, Range("A1:A2")
        AlimList ListBox1, Range("D10:D" & Range("D" & Rows.Count).End(xlUp).Row)
        AlimList ListBox2, tstPlage
        'AlimList ListBox2, Range("E10:E" & Range("E" & Rows.Count).End(xlUp).Row)
        AlimList ListBox3, Range("F10:F" & Range("F" & Rows.Count).End(xlUp).Row)
        AlimList ListBox4, Range("L10:L" & Range("L" & Rows.Count).End(xlUp).Row)
 
    End With
End Sub

J'obtiens une erreur 424 - objet requis sur l'appel d'Alim Listbox avec tstPlage, et j'ai eu beau essayer de tourner la chose dans tous les sens, je n'y arrive pas.
Des idées ? :(

14/04/2009, 15h22
LeForestier

Bonjour,
je pense que tu doit remplacer..

Code:

Private Sub AlimList(lst As Object, ByVal Target As Excel.Range)

par

Code:

Private Sub AlimList(lst As ListBox, ByVal Target As Excel.Range)

Je n'ai pas regarder le reste de tes codes.
A+
14/04/2009, 15h35
Michel Delapouaitte

Bonjour, et merci de t'attarder sur mon problème.

La fonction AlimList marche bien (à part le premier appel, d'où la poubelle à bug), et je me souviens avoir déjà essayé cette variante au moment où j'avais essayé de l'adapter, puis on m'avait suggéré de mettre lst en objet, et ça va nikel comme ça.
Le problème viendrait apparement de tstPlage, du coup c'est bien ma fonction plageValeur qui va pas. :?
14/04/2009, 16h13
Michel Delapouaitte

Re-bonjour à tous,

Je pense avoir mieux ciblé le problème :

Dans la fonction plageValeur, dans la ligne

Code:

Set plageValeur = maCell.Offset(, decal)

Offset me retourne la valeur de la cellule ciblée après décalage, alors que j'essaie de récupérer l'adresse de cette cellule.
J'ai essayé avec la propriété Address mais ça me renvoie une erreur d'incompatibilité de type précisément sur cette propriété (alors que quand je met un point après le offset ça me propose bien "address").

Du coup je bloque toujours pour récupérer l'adresse. :aie:
14/04/2009, 18h28
LeForestier

difficile de répondre avec des bribes de fonctions,
Toutefois, je pense que Offset nécesite 2 paramètres, si tu ne veux pas de différence de ligne tu doit mettre 0

Code:

maCell.Offset(0, decal))

Dès demain je me pencherais un peu plus sur ton problème, aujourd'hui j'ai pas trop le temps.
A+

Bonjour, et merci d'avoir encore passé du temps sur mon problème. J'ai essayé ce que tu m'as proposé, et ça ne change rien. En vba, dans les appels de fonction ou de méthode, mettre "0," ou simplement "," revient au même.

Autant je peux actualiser les box avec la valeur que la cellule contient retournée par offset, autant pour la suite des traitements que je dois faire sur les lignes qui seront selectionnées j'aurai vraiment besoin de connaitre l'adresse, ou au minimum la ligne (je pourrai me débrouiller ensuite).

Tu parles de bribes de fonctions, mais le code que j'ai mis est entier, mis à part quelques initialisations banales de checkbox. De quoi aurais-tu besoin ou quelles explications complémentaires puis-je te donner pour que tu cernes mieux le problème ?

En tout cas le problème se situe bien au niveau de cette instruction, puisque offset me donne une valeur que j'essaie de mettre dans un range, d'où l'incompatibilité de type.
Par la suite quand dans mon initialize j'ai logiquement une erreur lorsque je fais

Code:

AlimList ListBox2, tstPlage

puisque tstPlage est vide (il n'a pas été rempli par plageValeur).

J'ai essayé aussi avec Find, du coup j'ai adapté la fonction plageValeur comme suit :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Public Function plageValeur(ByVal valeurCherchee As Variant, ByVal plageRecherche As Excel.Range) As Range Dim maCell As Range Do Set maCell = plageRecherche.Find(What:=valeurCherchee, LookAt:=xlWhole) If Not maCell Is Nothing Then If plageValeur Is Nothing Then Set plageValeur = maCell Else Set plageValeur = Application.Union(plageValeur, maCell) End If End If Loop While (Not maCell Is Nothing) End Function
Mais malgré que plageRecherche soit bien un range, je me casse maintenant les dents sur une erreur 1004 "impossible de lire la propriété find de la classe range".

Je n'ai vraiment aucune préférence sur la manière de faire, je voudrais juste récupérer cette fichue adresse.:(

15/04/2009, 14h36
LeForestier

Re,
Suis occupé à debuguer ton truc, deja tu peu enlever les ByVal dans ta fonction, il n'y a rien qui est transmis..!!!

Code:

Public Function plageValeur(valeurCherchee As String, plageRecherche As Range, ByVal decal As Integer) As Range

Comme ça les valeurs sont transmises et sont correctes.
Je continue..
15/04/2009, 15h14
Michel Delapouaitte

Ok.

Encore merci de me faire profiter de ton temps et de ton savoir.

Bon, j'ai presque terminer...
1°) changer la fonction, (tu verras plus bas)
Code:

1 2 3 4 5 6 7 8 9 10 Public Function plageValeur(valeurCherchee As String, plageRecherche As Range, ByVal decal As Integer) As String Dim maCell As Range Dim plage As String For Each maCell In plageRecherche If maCell.Value = valeurCherchee Then plage = plage & "," & maCell.Offset(, decal).Address End If Next maCell plageValeur = Mid(plage, 2) End Function
2°) Changer les arguments de la sub,
Code:

1 2 'alimente une listbox lst à partir d'une plage Target de la feuil1 (nom = "BASE") Private Sub AlimList(lst As msforms.ListBox, Target As Range)
3°) Toutes les listes sont remplies convenablement sauf...

Code:

AlimList ListBox2, Range(tstPlag)

Motif..

Code:

tablo = Target.Value

ne fonctionne pas sur des plages avec adresses discontinues, faudra faire une sub à part pour celle-là.
Tu peu t'en chargé ? Sinon tu dis...
A+

15/04/2009, 16h17
Michel Delapouaitte

Merci beaucoup de ton aide, en effet plageValeur me renvoie maintenant quelque chose d'exploitable et ça ne plante plus.

Je vais chercher comment exploiter les adresses qui sont dans le string renvoyé. je vais peut-être le découper. Enfin je vais essayer de voir ça par moi-même j'aime pas faire le blaireau à demander du tout cuit, et je ne voudrais pas abuser de ta gentillesse.

Encore merci. :king::ave:

EDIT : juste une petite question : Saurais-tu pourquoi offset renvoie tout sauf un range, alors que l'aide et tout ce que j'ai pu trouver stipulent qu'elle renvoie un range ?
15/04/2009, 17h37
LeForestier
Citation:

EDIT : juste une petite question : Saurais-tu pourquoi offset renvoie tout sauf un range, alors que l'aide et tout ce que j'ai pu trouver stipulent qu'elle renvoie un range ?

Parce que j'ai mis ".Address".
Et dans un traitement par plage tu dois pouvoir te servir de la plage.
J'ai plus l'occasion de tester mais..
Code:

1 2 3 4 5 6 7 Dim Cel as range i = 0 For Cel in Plage Redim preserve tablo(i) tablo(i) = cel.value i = i +1 next Cel
Et avec ce tableau tu peu faire une foncion Tri alpha et ensuite une fonction doublon.
Mais comme les dimentions sont différentes tu doit le faire dans une autre fonction.

A+

bonjour le fil suite a un autre post a mon avis il faut faire le plus simple possible
j utilise pas CreateObject("Scripting.Dictionary") pas sur excel 97 le prends
un exemple un userform 2 listbox
code
Option Explicit
Dim T, z As Variant, l As Collection, i As Long, j As Long, c As Range, temp

Code:

1
2
3
4
5
6
7
8
9
Private Sub ListBox1_Change()
i = Range("d65536").End(xlUp).Row
ListBox2.Clear
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
For Each c In Range("e10", [e65000].End(xlUp))
If ListBox1.List(i) = c.Offset(0, -1).Value Then ListBox2.AddItem c
Next: End If: Next i
 End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub UserForm_Initialize()
On Error Resume Next
Set l = New Collection
T = Range("d10:d" & Range("d65536").End(xlUp).Row)
For i = LBound(T) To UBound(T)
l.Add T(i, 1), T(i, 1): Next
For Each z In l
ListBox1.AddItem z: Next
For i = 0 To ListBox1.ListCount - 1
For j = 0 To ListBox1.ListCount - 1
If ListBox1.List(i) < ListBox1.List(j) Then
temp = ListBox1.List(i)
ListBox1.List(i) = ListBox1.List(j)
ListBox1.List(j) = temp
End If: Next j: Next i
End Sub

15/04/2009, 18h32
LeForestier

laetitia
Tu est sûr de ne pas t'être trompée de topic ? :P
A+
16/04/2009, 08h32
Michel Delapouaitte

Bonjour à tout les 2 (et aux autres lecteurs aussi pendant qu'on y est :mrgreen:).

Merci pour votre aide. Je vais utiliser le petit bout de code que LeForestier a donné et continuer à fouiller dans cette direction.

Par contre Laetitia je ne comprends pas tout dans ton code, du coup si ça plante je vais pas forcément savoir le débugger. :? Et comme pour l'instant j'approche du but je suis pas trop chaud pour tout reprendre du début pour la Nième fois.

Edit : LeForestier, je suis bien d'accord avec toi, mais sans mettre "address", d'après l'aide offset est censé renvoyer un range décalé.
16/04/2009, 09h48
LeForestier

Citation:

Envoyé par Michel Delapouaitte

Edit : LeForestier, je suis bien d'accord avec toi, mais sans mettre "address", d'après l'aide offset est censé renvoyer un range décalé.

Je n'ai jamais dis le contraire, mais dans ce cas j'ai pensé qu'il était préférable de travailler directement sur les adresses mais bien entendu tu fait comme tu veux en tenant quand même compte de ma remarque concernant Target.Value qui ne prend pas une plage avec cellules discontinues, du moins c'est ce que j'ai constaté.
A+
16/04/2009, 11h15
Michel Delapouaitte

Oui oui ben d'ailleurs j'ai suivi ta méthode, c'est juste que sur ce coup l'aide de VBE s'est gourré je pense.

Bon, par contre, VBE n'aime pas le

Code:

for cel in plage

et veut pas compiler. Il veut un "=" à la place du "in".
Aurais-tu une petite feinte pour pas que j'aie à découper "plage" pour récupérer chaque adresse ?
16/04/2009, 11h30
LeForestier

Peut-être avec

Code:

For Each cel in Range(Plage)

Tu avais raison, avec cette syntaxe j'arrive effectivement à récupérer la valeur de la cellule concernée.

Par contre ça plante sur les 2 lignes en rouge :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
'pour actualiser une listbox lst en fonction des entrées sélectionnées dans lstCle
'plgLstCle = range de plgLstCle
'decal = nombre de colonnes dont il faut décaler par rapport à plgLstCle pour considérer le range de lst

Private Sub ActualList(lst As msforms.ListBox, lstCle As msforms.ListBox, plgLstCle As Range, decal As Integer)

Dim plage As String
Dim tablo As Variant, Tempo As Variant, i As Long, j As Long
Dim i As Integer
Dim cel As Range
Dim item
'on appelle plageValeur avec les entrees selectionnees
For item = 0 To lstCle.ListCount - 1
    If lstCle.Selected(item) = True Then
        If plage = "" Then
            plage = plageValeur(lstCle.List(item), plgLstCle, decal)
        Else
            plage = plage & "," & plageValeur(lstCle.List(item), plgLstCle, decal)
        End If
    End If
Next

    i = 0
    For Each cel In Range(plage)
        ReDim Preserve tablo(i)
        tablo(i) = cel.Value
        i = i + 1
    Next cel

'TriAlpha
For i = 0 To UBound(tablo)
        For j = 1 To UBound(tablo)
            If tablo(i, 1) < tablo(j, 1) Then
                Tempo = tablo(i, 1)
                tablo(i, 1) = tablo(j, 1)
                tablo(j, 1) = Tempo
            End If
        Next j
    Next i

'Remplissage excluant les doublons
    lst.AddItem tablo(1, 1)
    For i = 2 To UBound(tablo)
        If tablo(i, 1) <> tablo(i - 1, 1) Then lst.AddItem tablo(i, 1)
    Next
    lst.ListIndex = -1
End Sub

Erreur 13 : type incompatible.

J'ai vérifié que ça ne venait pas du

Code:

ReDim Preserve tablo(i)

lorsque i vaut 0, ni du fait que i soit un long (j'ai essayé en integer).

Donc, je bloque encore. :?

Bon, j'ai trouvé d'où venait le problème, et corrigé.

La déclaration de "tablo" dans le code précédent est donc maintenant :

Code:

Dim tablo() As Variant

(y'a les parenthèses en plus)

Et j'ai modifié la fin de la sub comme suit
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 For i = 0 To UBound(tablo) For j = 1 To UBound(tablo) If tablo(i) < tablo(j) Then Tempo = tablo(i) tablo(i) = tablo(j) tablo(j) = Tempo End If Next j Next i 'Remplissage excluant les doublons lst.AddItem tablo(1) For i = 2 To UBound(tablo) If tablo(i) <> tablo(i - 1) Then lst.AddItem tablo(i) Next lst.ListIndex = -1
J'ai modifié les tablo(i, 1) , tablo(j, 1), etc... par tablo(i), tablo(j) car j'avais une erreur d'indice en dehors de la plage, qui semblait venir du 1.

Mais je me tappe maintenant une erreur d'exécution 1004 "la méthode 'Range' de l'objet '_global' a échoué" sur la ligne

Code:

For Each cel In Range(plage)

Et ce qui est encore plus étrange c' est que quand je vérifie les valeurs, "plage" est vide, alors qu'avant de virer les 1 y'avait bien les adresses dedans.:evilred:

J'ai vérifié avec une donnée valide dans plage..

Code:

1
2
3
4
5
6
7
8
Dim plage As String
plage = "B3,B8,C8,D4"
   i = 0
    For Each cel In Range(plage)
        ReDim Preserve tablo(i)
        tablo(i) = cel.Value
        i = i + 1
    Next cel

et ça sort bien le résultat attendu
deux pistes..
Tu n'active aucune feuille dans la sub, elle ne serait pas changée ailleur ?
Suivre la sub.. plageValeur et controller ce qu'elle renvoi.

Remarque .. Tu fait

Code:

1
2
3
4
5
6
7
8
9
For item = 0 To lstCle.ListCount - 1
    If lstCle.Selected(item) = True Then
        If plage = "" Then
            plage = plageValeur(lstCle.List(item), plgLstCle, decal)
        Else
            plage = plage & "," & plageValeur(lstCle.List(item), plgLstCle, decal)
        End If
    End If
Next

alors que...

Code:

1
2
3
4
5
6
For item = 0 To lstCle.ListCount - 1
    If lstCle.Selected(item) = True Then
        plage = plage & "," & plageValeur(lstCle.List(item), plgLstCle, decal)
    End If
Next
plage = Mid(plage, 2)

suffit.

17/04/2009, 13h32
Michel Delapouaitte

Bonjour à tous.

Bon. J'ai essayé de tourner la chose dans pas mal de sens encore ce matin, mais ça ne marche toujours pas.:(
Entre temps, il y a eu un changement de cahier des charges, du coup je vais plus du tout faire comme ça.

Merci beaucoup pour ton aide LeForestier, et merci à Laetitia aussi, même si j'ai pas tout compris aux bouts de codes que tu as postés.;)

Bonne journée à tous.:salut: