Combobox en cassade multi-liaison Besoin d'un Expert VBA

Bonjour,

Comment puis-je récupérer la ligne qui correspond a la sélection des combobox1 2 3 4?

afin pouvoir lier la recherche des combobox au bouton modifier ou supprimer ou sélectionner.

Le bouton sélectionner doit remplir une ligne dans la liste box.

il sélection les informations filtrer par les combobox ( la ligne qui correspond)

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.

et j'aimerai créé dans une autre feuille un historique de toutes les actions effectuées

est-ce possible?

pouvez-vous m'aider ou me diriger vers une personne capable de m'aider?

mon fichier est trop volumineux MP me pour plus de renseignement.

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 l'ajout d'un pièce?", vbYesNo, "Confirmation") = vbYes Then
  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

  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 Supprimer_Click()
Dim Supr As Integer
If Not ComboBox2.Value <> "" Then
Set Ws = Worksheets("BD")
Sheets("BD").Select
Supr = ComboBox2.ListIndex + 2
Cells(Supr, 1).EntireRow.Delete
End If
Unload Programe
Programe.Show
End Sub

Quelqu'un peux m'aider?

s'il vous plais aider moi la macro est presque finaliser

Bonjour Voici tous les macro que j'ai faite sans résultat valable:

Aidez moi s'il vous plait je suis larger

bonjour

on comprend pas grand chose tu a des problème de structure

deja tes tableau

ton userform il manque des varriable

tes texbox mettre dans l'ordre pour pouvoire des routine

et voir ta listbox

voila une essais a toi de voir

A+

Maurice

Bonjour Maurice,

Merci pour avoir modifier l'apparence et les dimensions de mes colonnes de ma listebox mais ça j'avais compris rien de bien sorciers

Mon problème est que je n'arrive pas a récupérer le numéro de la ligne filtré par mes combobox (encore faut il que les 4 combobox fonctionnent correctement! cela est le cas si j'utilise Array mais je perd ma ligne active) afin de pouvoir les ajouter une ligne ou la modifier ou la supprimer et de pouvoir ajouter ce que je veux dans ma listebox avec le bouton sélectionner

Bouton Sélectionner:

Copie les valeurs des cellule nécessaire de ma feuille BD filtré par mes combobox (tableau dans la feuille Liste)

donc Copie-Colle cellule de BD a Liste (je ne copie pas la bonne ligne avec ce code

Dim ii As Variant
ii = ComboBox2.ListIndex + 2
Cells(ii, 3) = TextBox1.Value

Bouton suprimmer2:

Private Sub Supprimer2_Click()
    If MsgBox("    CONFIRMER LA SUPPRESSION ", vbYesNo, "Message") = vbYes Then
        Me.ListBox1.RemoveItem (Me.ListBox1.ListIndex)
         End If
 InitList
End Sub

Bouton Imprimer:

Imprime la ou les pages mise en forme dans la feuille liste j'ai pas encore eu le temps de mis penché

Et pour Finir la création d'un historique a chaque fois que le bouton ajouter modifier supprimer et clické

je ne pense pas que ce soit compliquer mais j'ai pas encore eu le temps de mis penché

Je joint un nouveau fichier avec mes nouvelles modifications

Pour info mes bouton fonctionne avec ce code

Private Sub UserForm_initialize()
    'Définit la feuille contenant les données
    Set Ws = Worksheets("BD")
    'Définit le nombre de lignes dans la colonne C
    NbLignes = Ws.Range("C65536").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, ComboBox2.Value
End Sub

Private Sub ComboBox3_Change()
Dim i As Long

Me.TextBox1 = ""
Me.TextBox2 = ""
Me.TextBox3 = ""
Me.TextBox4 = ""
Me.TextBox5 = ""
Me.TextBox6 = ""
Me.TextBox7 = ""
Me.TextBox8 = ""
Me.TextBox9 = ""

If Me.ComboBox1.ListIndex > -1 And Me.ComboBox2.ListIndex > -1 And Me.ComboBox3.ListIndex > -1 Then
    With Ws
        For i = 2 To NbLignes
            If .Range("C" & i) = Me.ComboBox1 And .Range("D" & i) = Me.ComboBox2 And .Range("E" & i) = Me.ComboBox3 Then
                Me.TextBox1 = .Range("C" & i)
                Me.TextBox2 = .Range("B" & i)
                Me.TextBox3 = .Range("D" & i)
                Me.TextBox4 = .Range("E" & i)
                Me.TextBox5 = .Range("F" & i)
                Me.TextBox6 = .Range("G" & i)
                Me.TextBox7 = .Range("H" & i)
                Me.TextBox8 = .Range("I" & i)
                Me.TextBox9 = .Range("J" & i)
                Exit For
            End If
        Next i
    End With
End If
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 B (à partir de la 2eme ligne)
        For j = 2 To NbLignes
            Obj = Ws.Range("C" & j)
            'Remplit le ComboBox sans doublons
            If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("C" & 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("C" & j).Offset(0, CbxIndex - 2) = Cible Then
                Obj = Ws.Range("C" & j).Offset(0, CbxIndex - 1)
                If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("C" & j).Offset(0, CbxIndex - 1)
            End If
        Next j
   End If

   'Enlève la sélection dans le ComboBox
   Obj.ListIndex = -1
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 Integer
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, 3) = TextBox1.Value
Cells(Ligne, 4) = TextBox3.Value
Cells(Ligne, 5) = TextBox4.Value
Cells(Ligne, 6) = TextBox5.Value
Cells(Ligne, 7) = TextBox6.Value
Cells(Ligne, 8) = TextBox7.Value
Cells(Ligne, 9) = TextBox9.Value
Cells(Ligne, 10) = TextBox8.Value

Unload UserForm1
UserForm1.Show
End If
End Sub

Private Sub Modifier_Click()
Dim Modif As Integer
If Not (TextBox1.Value <> "" And TextBox3.Value <> "" And TextBox4.Value <> "" And TextBox5.Value <> "") Then
MsgBox ("Veuillez renseigner les champs")
Exit Sub
Set Ws = Worksheets("BD")

Modif = ComboBox2.ListIndex + 2
Cells(Modif, 1) = ActiveCell.Row
Cells(Modif, 2) = TextBox2.Value
Cells(Modif, 3) = TextBox1.Value
Cells(Modif, 4) = TextBox3.Value
Cells(Modif, 5) = TextBox4.Value
Cells(Modif, 6) = TextBox5.Value
Cells(Modif, 7) = TextBox6.Value
Cells(Modif, 8) = TextBox7.Value
Cells(Modif, 9) = TextBox9.Value
Cells(Modif, 10) = TextBox8.Value
MsgBox ("Modification effectuer")
Else
MsgBox ("Veuillez selectionné la ref de la pièce a modifier")
Unload UserForm1
UserForm1.Show
Exit Sub
End If
End Sub

Private Sub Supprimer_Click()
Dim Supr As Integer
If Not TextBox2.Value = "" Then
Set Ws = Worksheets("BD")
Sheets("BD").Select
Supr = ComboBox2.ListIndex + 2
Cells(Supr, 1).EntireRow.Delete
End If
Unload UserForm1
UserForm1.Show
End Sub

Help Pls

Bonjour

comme j'ais rien compris j'ais refais un modele de base

sa peux peu être te servir

A+

Maurice

Re

voila avec une combobox

A+

Maurice

Merci Marcus je vais voir ce que je peux en tiré aujourd'hui et je reviens vers toi pour plus de précision.

Re Maurice

Voici ce que je suis arriver a faire en combinant nos Code

Reste de faire le bouton Imprimer et l'histoire

bonjour

ses pas la peine que je fasse des routines pour rien

je laisse tomber je comprend plus rien

aller bon courage

A+

Maurice

re mon fichier est fonctionnel comme je le veux merci quand même tu m'a permis de débloqué la situation

Rechercher des sujets similaires à "combobox cassade multi liaison besoin expert vba"