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
Bonjour
comme j'ais rien compris j'ais refais un modele de base
sa peux peu être te servir
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