4 combobox en cascade:problème

Version imprimable

Bon là je galère.
Mon code doit alimenter 4 combobox en cascade. Ca signifie que lorsque je sélectionne une valeur dans ma première combobox1, en gardant la valeur sélectionner il m'affiche dans la combobox2 la liste des résultat en lien avec la première uniquement ainsi de suite.:roll:

Seulement le code que j'ai récupéré a une faille, car lorsque je sélectionne la combobox3 elle ne tien plus compte du résultat de la première mais seulement de la seuxième?????:cry::cry:

Voilà le problème dans mon code:

Code:

1
2
3
4
Private Sub ComboBox2_Change()
    'Remplissage Combo3
    Alim_Combo 3, ComboBox2.Value
End Sub

Voilà se que je pensais faire et qui ne marche pas

Code:

1
2
3
4
Private Sub ComboBox2_Change()
    'Remplissage Combo3
    Alim_Combo 3, ComboBox1.Value and ComboBox2.Value
End Sub

et voilà mon code en entier

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
 
'Les données sont dans les colonnes A à D, d'un onglet nommé "Base".
'La procédure effectue un remplissage conditionnel des Combobox en fonction de
'ce qui est sélectionnée dans le contrôle précédent:
'La sélection du ComboBox1 (données colonne A) définit le contenu du ComboBox2 (données colonne B) ,
'La sélection du ComboBox2 définit le contenu du ComboBox3 (données colonne C) …etc...
'
Private Sub UserForm_Initialize()
    'Définit la feuille contenant les données
    Set Ws = Worksheets("Base")
    'Définit le nombre de lignes dans la colonne A
    NbLignes = Ws.Range("A65536").End(xlUp).Row
    'Remplissage du ComboBox1
    Alim_Combo 1
 
End Sub
 
Private Sub ComboBox1_Change()
    'Remplissage Combo2
    Alim_Combo 2, ComboBox1.Value
End Sub
 
Private Sub ComboBox2_Change()
    'Remplissage Combo3
    Alim_Combo 3, ComboBox1.Value
End Sub
 
Private Sub ComboBox3_Change()
    'Remplissage Combo4
    Alim_Combo 4, ComboBox3.Value
End Sub
 
'Procédure pour alimenter les ComboBox
Private Sub Alim_Combo(CbxIndex As Integer, Optional Cible As Variant)
    Dim j As Integer
    Dim Obj As Control
 
    'Définit le ComboBox à remplir
    Set Obj = Me.Controls("ComboBox" & CbxIndex)
    'Supprime les anciennes données
    Obj.Clear
 
    'alimente le Combobox initial (Combobox1)
    If CbxIndex = 1 Then
        'Boucle sur les lignes de la colonne A (à partir de la 2eme ligne)
        For j = 2 To NbLignes
            Obj = CStr(Ws.Range("A" & j))
            'Remplit le ComboBox sans doublons
            If Obj.ListIndex = -1 Then Obj.AddItem CStr(Ws.Range("A" & j))
        Next j
    Else
        'Alimentation conditionnelle des autres Combobox en fonction de
        'ce qui est sélectionnée dans le contrôle précédent:
        '(La sélection du ComboBox1 définit le contenu du ComboBox2,
        'La sélection du ComboBox2 définit le contenu du ComboBox3 …etc...)
        For j = 2 To NbLignes
            If Ws.Range("A" & j).Offset(0, CbxIndex - 2) = CStr(Cible) Then
                Obj = CStr(Ws.Range("A" & j).Offset(0, CbxIndex - 1))
                If Obj.ListIndex = -1 Then Obj.AddItem CStr(Ws.Range("A" & j).Offset(0, CbxIndex - 1))
            End If
        Next j
   End If
 
   'Enlève la sélection dans le ComboBox
   Obj.ListIndex = -1
End Sub

30/03/2010, 09h28
mercatog
c'est logique puisque tu lui dis de faire ainsi ici (1)

Code:

If Ws.Range("A" & j).Offset(0, CbxIndex - 2) = CStr(Cible) Then

explique ceci
Code:

1 2 3 4 Private Sub ComboBox2_Change() 'Remplissage Combo3 Alim_Combo 3, ComboBox2.Value End Sub
combo1 alimentée par A
combo2 par B
(1) donne, si Bi=combo2 then
dans cette condition, on ajoute chaque cellule de la colonne C dans combo3 où la cellule de colonne B est égale au contenu de combo2 sans parler de la cellule de la colonne A qui devrait être égale à combo1
30/03/2010, 10h03
adriennoob
En fait j'ai récupéré du code sur ce forum, alors pour se qui est d'expliquer je veux bien essayer :

En fait quand ma combobox2 est sélectionné et affiche une valeur, elle me permet d'alimenter ma combobox3.
Code:

1 2 3 4 Private Sub ComboBox2_Change() 'Remplissage Combo3 Alim_Combo 3, ComboBox2.Value End Sub
Tu pourrais me dire si t'as une idée comment liée toute les valeurs de mes combobox???? :calim2::calim2:
30/03/2010, 11h36
mercatog

si joint 2 discussion qui traitent du même sujet, à adapter
http://www.developpez.net/forums/d86...bobox-cascade/
http://www.developpez.net/forums/d86...u/#post4924217

J'ai tjr un problème, mais ça va je retrouve le sourir :); maintenant mes liste déroulante ne m'affichent que la première ligne de mon tableau de donnée.

Donc dans ma combox1 je n'ai que la cellule A1, dans la combobox2 je n'ai que la cellule A2...

La je comprend pas????

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
Private Sub UserForm_Initialize()
 
Dim j As Long
Dim kol As New Collection
 
Set Ws = Worksheets("Base")
NbLignes = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
For j = 2 To NbLignes
    On Error Resume Next
    kol.Add Ws.Range("A" & j).Value, CStr(Range("A" & j).Value)
Next j
 
For j = 1 To kol.Count
    Me.ComboBox1.AddItem kol(j)
Next j
 
End Sub
 
 
Private Sub ComboBox1_Change()
Dim j As Long
Dim kol As New Collection
 
For j = 2 To NbLignes
    On Error Resume Next
    If CStr(Ws.Range("A" & j).Value) = Me.ComboBox1.Value Then kol.Add Ws.Range("B" & j).Value, CStr(Range("B" & j).Value)
Next j
Me.ComboBox2.Clear
For j = 1 To kol.Count
    Me.ComboBox2.AddItem kol(j)
Next j
End Sub
 
 
Private Sub ComboBox2_Change()
Dim j As Long
Dim kol As New Collection
 
For j = 2 To NbLignes
    On Error Resume Next
    If CStr(Ws.Range("A" & j).Value) = Me.ComboBox1.Value And CStr(Ws.Range("B" & j).Value) = Me.ComboBox2.Value Then kol.Add Ws.Range("C" & j).Value, CStr(Range("C" & j).Value)
Next j
Me.ComboBox3.Clear
For j = 1 To kol.Count
    Me.ComboBox3.AddItem kol(j)
Next j
End Sub

30/03/2010, 14h31
mercatog
as tu déclaré tes variables dans un module public?
Code:

1 2 Public ws as worksheet Public NbLignes as long

Voilà en gros mon code au complet, donc tu peux voir que j'ai déclaré mes variable dans l'option explicit. Ca vient de là????:calim2:

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Option Explicit
 
Dim Ws As Worksheet
Dim NbLignes As Integer
Dim K As Integer
Dim i As Integer
Dim LaDerniere As Integer
Dim j As Integer
Dim b_existe As Boolean
Dim f As Integer
Dim kol As New Collection
 
Function IsExist(ByVal NameSheet As String) As Boolean
    Dim oSheet As Worksheet
 
For Each oSheet In ThisWorkbook.Sheets
    If oSheet.Name = NameSheet Then
    IsExist = True: Exit For
    End If
Next oSheet
 
End Function
Private Sub CommandButton1_Click()
 
 
If Not IsExist("à envoyer") Then
Sheets.Add: ActiveSheet.Name = "à envoyer"
Else
Worksheets("à envoyer").Rows("2:6655").ClearContents
End If
 
LaDerniere = Worksheets("Base").Cells(4000, 2).End(xlUp).Row
K = 1
For i = 2 To LaDerniere
 
If ComboBox2.Value = "" And ComboBox3.Value = "" And ComboBox4.Value = "" Then
 
    If Worksheets("Base").Cells(i, 1) = ComboBox1.Value Then
    Worksheets("Base").Range("B" & i & ":F" & i & "").Copy
    Worksheets("création fiche").Range("G" & K & "").Select
    ActiveSheet.Paste
    Worksheets("création fiche").Range("F1") = "toto"
    K = K + 1
    End If
 
ElseIf ComboBox3.Value = "" And ComboBox4.Value = "" Then
 
    If Worksheets("Base").Cells(i, 2) = ComboBox2.Value Then
    Worksheets("Base").Range("C" & i & ":F" & i & "").Copy
    Worksheets("création fiche").Range("G" & K & "").Select
    ActiveSheet.Paste
    K = K + 1
    End If
 
ElseIf ComboBox4.Value = "" Then
 
    If Worksheets("Base").Cells(i, 3) = ComboBox3.Value Then
    Worksheets("Base").Range("D" & i & ":F" & i & "").Copy
    Worksheets("création fiche").Range("G" & K & "").Select
    ActiveSheet.Paste
    K = K + 1
    End If
 
ElseIf Not (ComboBox4.Value = "") Then
    If Worksheets("Base").Cells(i, 4) = ComboBox4.Value Then
    Worksheets("Base").Range("E" & i & ":F" & i & "").Copy
    Worksheets("création fiche").Range("G" & K & "").Select
    ActiveSheet.Paste
    K = K + 1
    End If
 
End If
 
Next i
UserForm1.Hide
End Sub
 
 
 
 
Private Sub UserForm_Initialize()
 
Dim j As Long
Dim kol As New Collection
 
Set Ws = Worksheets("Base")
NbLignes = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
For j = 2 To NbLignes
    On Error Resume Next
    kol.Add Ws.Range("A" & j).Value, CStr(Range("A" & j).Value)
Next j
 
For j = 1 To kol.Count
    Me.ComboBox1.AddItem kol(j)
Next j
 
End Sub
 
 
Private Sub ComboBox1_Change()
Dim j As Long
Dim kol As New Collection
 
For j = 2 To NbLignes
    On Error Resume Next
    If CStr(Ws.Range("A" & j).Value) = Me.ComboBox1.Value Then kol.Add Ws.Range("B" & j).Value, CStr(Range("B" & j).Value)
Next j
Me.ComboBox2.Clear
For j = 1 To kol.Count
    Me.ComboBox2.AddItem kol(j)
Next j
End Sub
 
 
Private Sub ComboBox2_Change()
 
 
For j = 2 To NbLignes
    On Error Resume Next
    If CStr(Ws.Range("A" & j).Value) = Me.ComboBox1.Value And CStr(Ws.Range("B" & j).Value) = Me.ComboBox2.Value Then kol.Add Ws.Range("C" & j).Value, CStr(Range("C" & j).Value)
Next j
Me.ComboBox3.Clear
For j = 1 To kol.Count
    Me.ComboBox3.AddItem kol(j)
Next j
End Sub

Ton problème vient du fait que tu déclare la collection kol en public
alors qu'il fallait la déclarer à portée de chaque sub
ci-joint ton code (à tester)

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Option Explicit
 
Dim Ws As Worksheet
Dim NbLignes As Long
Dim K As Integer
Dim i As Integer
Dim LaDerniere As Integer
Dim b_existe As Boolean
Dim f As Integer
'Dim kol As New Collection /!\à Effacer d'ici
 
'.... J'ai pas vu
 
 
Private Sub UserForm_Initialize()
Dim j As Long
Dim kol As New Collection
 
Set Ws = Worksheets("Base")
NbLignes = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
For j = 2 To NbLignes
    On Error Resume Next
    kol.Add Ws.Range("A" & j).Value, CStr(Range("A" & j).Value)
Next j
 
For j = 1 To kol.Count
    Me.ComboBox1.AddItem kol(j)
Next j
 
End Sub
 
Private Sub ComboBox1_Change()
Dim j As Long
Dim kol As New Collection
 
For j = 2 To NbLignes
    On Error Resume Next
    If CStr(Ws.Range("A" & j).Value) = Me.ComboBox1.Value Then kol.Add Ws.Range("B" & j).Value, CStr(Range("B" & j).Value)
Next j
Me.ComboBox2.Clear
Me.ComboBox3.Clear
Me.ComboBox4.Clear
For j = 1 To kol.Count
    Me.ComboBox2.AddItem kol(j)
Next j
End Sub
 
 
Private Sub ComboBox2_Change()
Dim j as Long
Dim kol As New Collection 
 
For j = 2 To NbLignes
    On Error Resume Next
    If CStr(Ws.Range("A" & j).Value) = Me.ComboBox1.Value And CStr(Ws.Range("B" & j).Value) = Me.ComboBox2.Value Then kol.Add Ws.Range("C" & j).Value, CStr(Range("C" & j).Value)
Next j
Me.ComboBox3.Clear
Me.ComboBox4.Clear
For j = 1 To kol.Count
    Me.ComboBox3.AddItem kol(j)
Next j
End Sub
 
'Pour la combo4
Private Sub ComboBox3_Change()
dim j as long
Dim kol As New Collection
 
For j = 2 To NbLignes
    On Error Resume Next
    If CStr(Ws.Range("A" & j).Value) = Me.ComboBox1.Value And CStr(Ws.Range("B" & j).Value) = Me.ComboBox2.Value And CStr(Ws.Range("C" & j).Value) = Me.ComboBox3.Value Then kol.Add Ws.Range("D" & j).Value, CStr(Range("D" & j).Value)
Next j
Me.ComboBox4.Clear
For j = 1 To kol.Count
    Me.ComboBox4.AddItem kol(j)
Next j
End Sub

30/03/2010, 21h34
adriennoob

Merci c'ezst exactement ça je remercie le forum et mercatog. T'es super cool:ccool: