Combobox en cascade userform
Bonjour,
je suis nouveau ici sur ce forum, j'ai un petit problème au niveau des combobx en cascade, voila j'ai une liste de Wilayas que je veux quelle soit lié a une liste de Dairas qui a son tour est lié a une liste de Commune, je vous donne un exemple :
Wilaya : Adrar
Dairs : plusieurs dairas Adrar, aflou.......
Communes : plusieurs communes Adrar, Bouddha.......
une aide de votre part sera très gentille.
dans l'attente d'une réponse veuillez agréer mes salutations merci d'avance.
Bonjour Naim,
Ci-joint une démo.
Juste une remarque, il vaut mieux éviter les cellules fusionnées.
Cdlt
Pierre
Bonjour GVIALLES
je vous remercie pour votre aide, c'est exactement ce que je chercher.
1000 merci.
bonne continuation.
cordialement.
Bonjour,
Comment puis-je récupérer la ligne qui correspond a la recherche des combobox1 2 3 4?
afin pouvoir lier la recherche des combobox au bouton modifier ou supprimer ou sélectionner.
Les ligne a modifier sont celles surligner je pence.
Le bouton sélectionner doit remplir une liste box afin de pouvoir imprimer une liste.
Option de la listebox:
- sélectionner une ligne dans la listebox afin de pouvoir supprimer la ligne dans la listebox.
est-ce possible?
- Imprimer la liste.
Pouvez vous m'aidez?
Par avance Merci
Dim f, BD(), ColcléCombo(), ColClé1, ColClé2, ColClé3, ColClé4
Private Sub UserForm_Initialize()
ColcléCombo = Array(3, 4, 5, 6) ' colonnes des combobox( à adapter)
Set f = Sheets("BD")
Set d1 = CreateObject("Scripting.Dictionary")
BD = f.Range("A2:T" & f.[A65000].End(xlUp).Row).Value ' Array pour rapidité (à adapter)
ColClé1 = ColcléCombo(0)
For i = LBound(BD) To UBound(BD): d1(BD(i, ColClé1)) = "": Next
Me.ComboBox1.List = d1.keys
End Sub
Private Sub ComboBox1_click()
Me.ComboBox2.Clear
Me.ComboBox3.Clear
Me.ComboBox4.Clear
ColClé2 = ColcléCombo(1)
Set d1 = CreateObject("Scripting.Dictionary")
For i = LBound(BD) To UBound(BD)
If BD(i, ColClé1) = Me.ComboBox1 Then d1(BD(i, ColClé2)) = ""
Next i
Me.ComboBox2.List = d1.keys
End Sub
Private Sub ComboBox2_click()
Me.ComboBox3.Clear
Me.ComboBox4.Clear
ColClé3 = ColcléCombo(2)
Set d1 = CreateObject("Scripting.Dictionary")
For i = LBound(BD) To UBound(BD)
If BD(i, ColClé1) = Me.ComboBox1 And BD(i, ColClé2) = Me.ComboBox2 Then d1(BD(i, ColClé3)) = ""
Next i
Me.ComboBox3.List = d1.keys
End Sub
Private Sub ComboBox3_click()
Me.ComboBox4.Clear
ColClé4 = ColcléCombo(3)
Set d1 = CreateObject("Scripting.Dictionary")
For i = LBound(BD, 1) To UBound(BD, 1)
If BD(i, ColClé1) = Me.ComboBox1 And BD(i, ColClé2) = Me.ComboBox2 _
And BD(i, ColClé3) = Me.ComboBox3 Then d1(BD(i, ColClé4)) = ""
Next i
Me.ComboBox4.List = d1.keys
End Sub
Private Sub ComboBox4_click()
For i = LBound(BD) To UBound(BD)
If BD(i, ColClé1) = Me.ComboBox1 And BD(i, ColClé2) = Me.ComboBox2 _
And BD(i, ColClé3) = Me.ComboBox3 And BD(i, ColClé3) = Me.ComboBox3 Then
Me.TextBox1 = BD(i, 3)
Me.TextBox2 = BD(i, 1)
Me.TextBox3 = BD(i, 4)
Me.TextBox4 = BD(i, 5)
Me.TextBox5 = BD(i, 6)
Me.TextBox6 = BD(i, 7)
Me.TextBox7 = BD(i, 8)
Me.TextBox8 = BD(i, 9)
Me.TextBox9 = BD(i, 10)
Me.TextBox10 = BD(i, 2)
Me.CheckBox1 = f.Range("K" & i) = "OK" = True
Me.CheckBox2 = f.Range("L" & i) = "OK" = True
Me.CheckBox3 = f.Range("M" & i) = "OK" = True
Me.CheckBox4 = f.Range("N" & i) = "OK" = True
Me.CheckBox5 = f.Range("O" & i) = "OK" = True
Me.CheckBox6 = f.Range("P" & i) = "OK" = True
Me.CheckBox7 = f.Range("Q" & i) = "OK" = True
Me.CheckBox8 = f.Range("R" & i) = "OK" = True
Me.CheckBox9 = f.Range("S" & i) = "OK" = True
Me.CheckBox10 = f.Range("T" & i) = "OK" = True
End If
Next i
End Sub
Private Sub Ajout_Click()
Set Ws = Worksheets("BD")
If Not (TextBox1.Value <> "" And TextBox3.Value <> "" And TextBox4.Value <> "" And TextBox5.Value <> "") Then
MsgBox ("Veuillez renseigner les champs")
Exit Sub
End If
Dim Ligne As Variant
If MsgBox("Confirmez-vous l'ajout d'un pièce?", vbYesNo, "Confirmation") = vbYes Then
Ligne = Range("a1048576").End(xlUp).Row + 1
Cells(Ligne, 1) = ActiveCell.Row
Cells(Ligne, 2) = TextBox2.Value
Cells(Ligne, 4) = TextBox1.Value
Cells(Ligne, 5) = TextBox3.Value
Cells(Ligne, 6) = TextBox4.Value
Cells(Ligne, 7) = TextBox5.Value
Cells(Ligne, 8) = TextBox6.Value
Cells(Ligne, 9) = TextBox7.Value
Cells(Ligne, 10) = TextBox9.Value
Cells(Ligne, 11) = TextBox8.Value
Cells(Ligne, 3) = TextBox10.Value
End If
If CheckBox1.Value = True Then 'Si coché ...
Cells(Ligne, 11) = "OK"
Else 'Si non coché ...
Cells(Ligne, 11) = "NOK"
End If
If CheckBox2.Value = True Then 'Si coché ...
Cells(Ligne, 12) = "OK"
Else 'Si non coché ...
Cells(Ligne, 12) = "NOK"
End If
If CheckBox3.Value = True Then 'Si coché ...
Cells(Ligne, 13) = "OK"
Else 'Si non coché ...
Cells(Ligne, 13) = "NOK"
End If
If CheckBox4.Value = True Then 'Si coché ...
Cells(Ligne, 14) = "OK"
Else 'Si non coché ...
Cells(Ligne, 14) = "NOK"
End If
If CheckBox5.Value = True Then 'Si coché ...
Cells(Ligne, 15) = "OK"
Else 'Si non coché ...
Cells(Ligne, 15) = "NOK"
End If
If CheckBox6.Value = True Then 'Si coché ...
Cells(Ligne, 16) = "OK"
Else 'Si non coché ...
Cells(Ligne, 16) = "NOK"
End If
If CheckBox7.Value = True Then 'Si coché ...
Cells(Ligne, 17) = "OK"
Else 'Si non coché ...
Cells(Ligne, 17) = "NOK"
End If
If CheckBox8.Value = True Then 'Si coché ...
Cells(Ligne, 18) = "OK"
Else 'Si non coché ...
Cells(Ligne, 18) = "NOK"
End If
If CheckBox9.Value = True Then 'Si coché ...
Cells(Ligne, 19) = "OK"
Else 'Si non coché ...
Cells(Ligne, 19) = "NOK"
End If
If CheckBox10.Value = True Then 'Si coché ...
Cells(Ligne, 20) = "OK"
Else 'Si non coché ...
Cells(Ligne, 20) = "NOK"
End If
MsgBox ("Ajout éffectuer")
Unload Programe
Programe.Show
Exit Sub
End Sub
Private Sub Modifier_Click()
If Not (TextBox1.Value <> "" And TextBox3.Value <> "" And TextBox4.Value <> "" And TextBox5.Value <> "") Then
MsgBox ("Veuillez renseigner les champs")
Exit Sub
End If
If MsgBox("Confirmez-vous la modification?", vbYesNo, "Confirmation") = vbYes Then
[Surligner]For i = LBound(BD) To UBound(BD)
If BD(i, ColClé1) = Me.ComboBox1 And BD(i, ColClé2) = Me.ComboBox2 And BD(i, ColClé3) = Me.ComboBox3 And BD(i, ColClé3) = Me.ComboBox3 Then[/Surligner]
If CheckBox1.Value = True Then 'Si coché ...
Cells(i, 11) = "OK"
Else 'Si non coché ...
Cells(i, 11) = "NOK"
If CheckBox2.Value = True Then 'Si coché ...
Cells(i, 12) = "OK"
Else 'Si non coché ...
Cells(i, 12) = "NOK"
End If
If CheckBox3.Value = True Then 'Si coché ...
Cells(i, 13) = "OK"
Else 'Si non coché ...
Cells(i, 13) = "NOK"
If CheckBox4.Value = True Then 'Si coché ...
Cells(i, 14) = "OK"
Else 'Si non coché ...
Cells(i, 14) = "NOK"
If CheckBox5.Value = True Then 'Si coché ...
Cells(i, 15) = "OK"
Else 'Si non coché ...
Cells(i, 15) = "NOK"
If CheckBox6.Value = True Then 'Si coché ...
Cells(i, 16) = "OK"
Else 'Si non coché ...
Cells(i, 16) = "NOK"
If CheckBox7.Value = True Then 'Si coché ...
Cells(i, 17) = "OK"
Else 'Si non coché ...
Cells(i, 17) = "NOK"
If CheckBox8.Value = True Then 'Si coché ...
Cells(i, 18) = "OK"
Else 'Si non coché ...
Cells(i, 18) = "NOK"
If CheckBox9.Value = True Then 'Si coché ...
Cells(i, 19) = "OK"
Else 'Si non coché ...
Cells(i, 19) = "NOK"
If CheckBox10.Value = True Then 'Si coché ...
Cells(i, 20) = "OK"
Else 'Si non coché ...
Cells(i, 20) = "NOK"
Cells(i, 1) = TextBox2.Value
Cells(i, 3) = TextBox1.Value
Cells(i, 4) = TextBox3.Value
Cells(i, 5) = TextBox4.Value
Cells(i, 6) = TextBox5.Value
Cells(i, 7) = TextBox6.Value
Cells(i, 8) = TextBox7.Value
Cells(i, 10) = TextBox8.Value
Cells(i, 9) = TextBox9.Value
Cells(i, 2) = TextBox10.Value
MsgBox ("Modification effectuer")
End If
Next i
End If
End If
End If
End If
End If
End If
End If
End If
End If
Exit Sub
Unload Programe
Programe.Show
End Sub
Private Sub Rechercher_Click()
If Not (ComboBox1.Value <> "" And ComboBox2.Value <> "") Then
MsgBox ("Veuillez renseigner les champs")
Dim No_Ligne As Integer
Set Ws = Worksheets("BD")
No_Ligne = ComboBox1.ListIndex + 2
Cells(No_Ligne, 1).Value = Cells(No_Ligne, 1).Value
'ComboBox1.Value = Cells(No_Ligne, 2).Value
'ComboBox2.Value = Cells(No_Ligne, 3).Value
TextBox1.Value = Cells(No_Ligne, 4).Value
TextBox2.Value = Cells(No_Ligne, 2).Value
TextBox3.Value = Cells(No_Ligne, 5).Value
TextBox4.Value = Cells(No_Ligne, 6).Value
TextBox5.Value = Cells(No_Ligne, 7).Value
TextBox6.Value = Cells(No_Ligne, 8).Value
'ComboBox3.Value = Cells(No_Ligne, 8).Value
TextBox7.Value = Cells(No_Ligne, 9).Value
TextBox8.Value = Cells(No_Ligne, 11).Value
TextBox9.Value = Cells(No_Ligne, 10).Value
TextBox10.Value = Cells(No_Ligne, 3).Value
Else
End If
End Sub
Private Sub Supprimer_Click()
Dim Supr As Integer
If Not ComboBox2.Value <> "" Then
Set Ws = Worksheets("BD")
Sheets("BD").Select
[Surligner]Supr = ComboBox2.ListIndex + 2[/Surligner]
Cells(Supr, 1).EntireRow.Delete
End If
Unload Programe
Programe.Show
End Sub