Combobox en cascade sur un userform

[tonyhv]

Bonjour a tous,

je n'arrive pas a monter une serie de 4 combobox en cascade dans un userform, j'ai bien essayer d'adapter plusieurs code trouvés dans le forum, mais je ne suis pas vraiement un pro du vba.
L'userform en question est frmparticipants, les combo sont pré-positionnées sur l'entete des colones que je voudrais qu'ils controlent.
cet userform me sert a selectionner les participants a une mission, j'ai besoin de garder la valeur de la BoundColumn, pour la suite de mes actions.
les combo ne doivent faire apparaitre que les lignes qui contiennent la valeur selectionné et en cascade.

je remercie par avance ceux qui voudront bien se pencher sur mon projet.

 

[tonyhv]

Re : Combobox en cascade sur un userform

salut a tous

Personne pour me donner un coup de main ??

 

[bqtr]

Re : Combobox en cascade sur un userform

Bonjour tonyhv,

Si si mais c'est pas évident de s'y retrouver dans tous ça .

Donc voici ce que j'ai fait :

- L'alimentation de la listbox est modifiée sinon le "RemoveItem" ne fonctionne pas.
- Chaque Combo est alimenté à l'initailisation du Userform sans doublon.

Tu filtres la listbox avec n'importe quel Combo, ce n'est pas à proprement parler des Combobox en cascade.

Bon le fichier ne passe pas donc voici les codes :

Private Sub UserForm_Initialize()
 
Dim coll As Collection, Cell As Range, k As Long
Dim Plg As Range
 
Set coll = New Collection
 
With ListBox1
    .ColumnCount = 17
    .ColumnWidths = "0cm;1cm;4,5cm;0cm;2cm;0cm;2cm;2,5cm;1cm;0cm;0cm;0cm;0cm;0cm;0cm;0cm;2,5cm"
End With
 
Set Plg = Sheets("Base").Range("A2:Q" & Sheets("Base").Range("A65536").End(xlUp).Row)
 
ListBox1.ColumnHeads = False
ListBox1.List = Plg.Value
ListBox1.BoundColumn = 1
txtCompteTotal = ListBox1.ListCount - 1
 
For Each Cell In Sheets("Base").Range("G2:G" & Sheets("Base").Range("H65536").End(xlUp).Row)
  On Error Resume Next
   coll.Add Cell.Value, CStr(Cell.Value)
  On Error GoTo 0
Next
 
For k = 1 To coll.Count
 CbxChoixAfect.AddItem coll.Item(k)
Next
 
Set coll = Nothing
Set coll = New Collection
 
For Each Cell In Sheets("Base").Range("H2:H" & Sheets("Base").Range("H65536").End(xlUp).Row)
  On Error Resume Next
   coll.Add Cell.Value, CStr(Cell.Value)
  On Error GoTo 0
Next
 
For k = 1 To coll.Count
 CbxChoixModu.AddItem coll.Item(k)
Next
 
Set coll = Nothing
Set coll = New Collection
 
For Each Cell In Sheets("Base").Range("I2:I" & Sheets("Base").Range("I65536").End(xlUp).Row)
  On Error Resume Next
   coll.Add Cell.Value, CStr(Cell.Value)
  On Error GoTo 0
Next
 
For k = 1 To coll.Count
 CbxChoixUnité.AddItem coll.Item(k)
Next
 
Set coll = Nothing
Set coll = New Collection
 
For Each Cell In Sheets("Base").Range("Q2:Q" & Sheets("Base").Range("Q65536").End(xlUp).Row)
  On Error Resume Next
   coll.Add Cell.Value, CStr(Cell.Value)
  On Error GoTo 0
Next
 
For k = 1 To coll.Count
 CbxChoixDateDepart.AddItem coll.Item(k)
Next
 
Set coll = Nothing
End Sub
 
Private Sub CbxChoixAfect_Change()
 
Dim i As Long
 
If CbxChoixAfect.ListIndex <> -1 Then
 For i = ListBox1.ListCount - 1 To 0 Step -1
   If ListBox1.List(i, 6) <> CbxChoixAfect Then ListBox1.RemoveItem (i)
 Next
End If
 
End Sub
 
Private Sub CbxChoixDateDepart_Change()
 
Dim y As Long
 
If CbxChoixDateDepart.ListIndex <> -1 Then
 For y = ListBox1.ListCount - 1 To 0 Step -1
   If ListBox1.List(y, 16) <> CDate(CbxChoixDateDepart) Then ListBox1.RemoveItem (y)
 Next
End If
 
End Sub
 
Private Sub CbxChoixModu_Change()
 
Dim k As Long
 
If CbxChoixModu.ListIndex <> -1 Then
 For k = ListBox1.ListCount - 1 To 0 Step -1
   If ListBox1.List(k, 7) <> CbxChoixModu Then ListBox1.RemoveItem (k)
 Next
End If
 
End Sub
 
Private Sub CbxChoixUnité_Change()
 
Dim z As Long
 
If CbxChoixUnité.ListIndex <> -1 Then
 For z = ListBox1.ListCount - 1 To 0 Step -1
   If ListBox1.List(z, 8) <> CbxChoixUnité Then ListBox1.RemoveItem (z)
 Next
End If
 
End Sub

Va falloir que je renouvelle ma cotisation

A+

 

[tonyhv]

Re : Combobox en cascade sur un userform

Merci bqtr,

Je rentrer ton code dans mon formulaire