combobox en cascade userform

Y compris Power BI, Power Query et toute autre question en lien avec Excel
n
naim
Nouveau venu
Nouveau venu
Messages : 6
Inscrit le : 21 janvier 2018
Version d'Excel : 2007 FR

Message par naim » 21 janvier 2018, 15:45

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.
PB2018 - Copie.xlsm
(63.98 Kio) Téléchargé 19 fois
Avatar du membre
pierrep56
Membre impliqué
Membre impliqué
Messages : 1'107
Appréciations reçues : 184
Inscrit le : 18 juin 2014
Version d'Excel : 2016

Message par pierrep56 » 21 janvier 2018, 17:04

Bonjour Naim,
Ci-joint une démo.
Juste une remarque, il vaut mieux éviter les cellules fusionnées.
Cdlt
Pierre
Combo_liées - Naim.xlsm
(59.87 Kio) Téléchargé 64 fois
Avatar du membre
GVIALLES
Membre dévoué
Membre dévoué
Messages : 814
Appréciations reçues : 73
Inscrit le : 28 novembre 2017
Version d'Excel : 2016, 360
Téléchargements : Mes applications

Message par GVIALLES » 21 janvier 2018, 19:50

Bonsoir Naim,

En pièce jointe une proposition.
PB2018 -GVS.xlsm
(60.79 Kio) Téléchargé 58 fois
Cordialement,

Gérard
n
naim
Nouveau venu
Nouveau venu
Messages : 6
Inscrit le : 21 janvier 2018
Version d'Excel : 2007 FR

Message par naim » 22 janvier 2018, 14:12

Bonjour GVIALLES
je vous remercie pour votre aide, c'est exactement ce que je chercher.
1000 merci.
bonne continuation.
cordialement.
Avatar du membre
GVIALLES
Membre dévoué
Membre dévoué
Messages : 814
Appréciations reçues : 73
Inscrit le : 28 novembre 2017
Version d'Excel : 2016, 360
Téléchargements : Mes applications

Message par GVIALLES » 5 février 2018, 11:06

Naim,

Nouvel essai d'envoi par le forum...
db2018_GVS.zip
(582.36 Kio) Téléchargé 35 fois
Cordialement,

Gérard
m
mordu77
Jeune membre
Jeune membre
Messages : 15
Inscrit le : 30 mars 2018
Version d'Excel : 2010

Message par mordu77 » 2 avril 2018, 17:29

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

Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message