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.

64pb2018-copie.xlsm (63.98 Ko)

Bonjour Naim,

Ci-joint une démo.

Juste une remarque, il vaut mieux éviter les cellules fusionnées.

Cdlt

Pierre

116combo-liees-naim.xlsm (59.87 Ko)

Bonsoir Naim,

En pièce jointe une proposition.

119pb2018-gvs.xlsm (60.79 Ko)

Bonjour GVIALLES

je vous remercie pour votre aide, c'est exactement ce que je chercher.

1000 merci.

bonne continuation.

cordialement.

Naim,

Nouvel essai d'envoi par le forum...

83db2018-gvs.zip (582.36 Ko)

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
Rechercher des sujets similaires à "combobox cascade userform"