probleme de combobox en cascade

fred82700

XLDnaute Nouveau
bonjour à tous,

j ai un soucis de combobox en cascade ! Pour les 3 premieres combo pas de soucis la 4eme ne marche pas si quelqu'un vois d ou cela peux venir

voici le code

Dim f



Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Set Mondico = CreateObject("Scripting.Dictionary")
For Each C In Range(f.[A2], f.[A65000].End(xlUp))
Mondico(C.Value) = C.Value
Next C
Me.ComboBox1.List = Mondico.items
End Sub
Private Sub ComboBox1_Change()
Set Mondico = CreateObject("Scripting.Dictionary")
For Each C In Range(f.[A2], f.[A65000].End(xlUp))
If C = Me.ComboBox1 Then Mondico(C.Offset(, 1).Value) = C.Offset(, 1).Value
Next C
Me.ComboBox2.List = Mondico.items
Me.ComboBox2.ListIndex = -1
Me.ComboBox3.ListIndex = -1
Me.combobox4.ListIndex = -1
End Sub
Private Sub ComboBox2_Change()
Set Mondico = CreateObject("Scripting.Dictionary")
For Each C In Range(f.[A2], f.[A65000].End(xlUp))
If C = Me.ComboBox1 And C.Offset(, 1) = Me.ComboBox2 Then Mondico(C.Offset(, 2).Value) = C.Offset(, 2).Value
Next C
Me.ComboBox3.List = Mondico.items
Me.ComboBox3.ListIndex = -1
Me.combobox4.ListIndex = -1
End Sub
Private Sub ComboBox3_Change()
Set Mondico = CreateObject("Scripting.Dictionary")
For Each C In Range(f.[A2], f.[A65000].End(xlUp))
If C = Me.ComboBox2 And C.Offset(, 1) = Me.ComboBox3 Then Mondico(C.Offset(, 3).Value) = C.Offset(, 2).Value
Next C
Me.combobox4.List = Mondico.items
Me.combobox4.ListIndex = -1
End Sub
Private Sub ComboBox4_Change()
Set Mondico = CreateObject("Scripting.Dictionary")
For Each C In Range(f.[A2], f.[A65000].End(xlUp))
If C = Me.ComboBox3 And C.Offset(, 1) = Me.combobox4 Then Mondico(C.Offset(, 4).Value) = C.Offset(, 2).Value
Next C
End Sub
Private Sub CommandButton1_Click()

num = Sheets("Reception").Range("A65536").End(xlUp).Row + 1
Sheets("Reception").Activate
Range("A" & num).Value = (Date_Réception)
Range("B" & num).Value = ComboBox1
Range("C" & num).Value = ComboBox3
Range("D" & num).Value = ComboBox2
Range("E" & num).Value = CDbl(Qtes_recues)
Range("F" & num).Value = combobox4
Range("G" & num).Value = Fournisseur
Range("H" & num).Value = REf_Fournisseur
Range("I" & num).Value = CDbl(Prix_HT)
Range("K" & num).Value = CDbl(Remise)
Range("M" & num).Value = CDbl(TVA)


Exit Sub

End Sub


je vous en remercie a l'avance
 

fred82700

XLDnaute Nouveau
Re : probleme de combobox 4 en cascade

bonjour,

je reviens vers vous avec mon probleme de combobox en cascade, je n arrive pas a trouver une solution les 3 premieres combobox marche tres bien la 4eme veux rien savoir


toute aide sera la bien venue

je joins mon fichier pour y jeter un coup d'oeil pour les experts ca devrais etre une routine pour moi c'est du chinoi


merci a tous


j ai un deuxieme soucis dans un textbox (numero de tel) quand je ne la remplis pas (je n'ai pas le numero) il me met un deboquage quelle est la formule pour eviter ca ..
 

Pièces jointes

  • fred82700.xlsm
    30.6 KB · Affichages: 47
  • fred82700.xlsm
    30.6 KB · Affichages: 49
  • fred82700.xlsm
    30.6 KB · Affichages: 52

Bebere

XLDnaute Barbatruc
Re : probleme de combobox en cascade

bonjour Fred,Dranreb
à tester

Code:
Private Sub ComboBox1_Change() 'famille
  Set Mondico = CreateObject("Scripting.Dictionary")
  For Each C In Range(f.[A2], f.[A65000].End(xlUp))
    If C = Me.ComboBox1 Then Mondico(C.Offset(, 1).Value) = C.Offset(, 1).Value
  Next C
  Me.ComboBox2.List = Mondico.items
  Me.ComboBox2.ListIndex = -1
  Me.ComboBox3.ListIndex = -1
  Me.ComboBox4.ListIndex = -1
End Sub
Private Sub ComboBox2_Change() 'n°
  Set Mondico = CreateObject("Scripting.Dictionary")
  For Each C In Range(f.[B2], f.[B65000].End(xlUp))
    If C = Me.ComboBox2 Then Mondico(C.Offset(, 1).Value) = C.Offset(, 1).Value
   Next C
   Me.ComboBox3.List = Mondico.items
   Me.ComboBox3.ListIndex = -1
   Me.ComboBox4.ListIndex = -1
End Sub
Private Sub ComboBox3_Change() 'désign
  Set Mondico = CreateObject("Scripting.Dictionary")
  For Each C In Range(f.[C2], f.[C65000].End(xlUp))
    If C = Me.ComboBox3 Then Mondico(C.Offset(, 8).Value) = C.Offset(, 8).Value
   Next C
   Me.ComboBox4.List = Mondico.items
   Me.ComboBox4.ListIndex = -1
End Sub
 

Dranreb

XLDnaute Barbatruc
Re : probleme de combobox en cascade

Bonjour.
Il y a quand même une Démo ComboBoxCasc dans mon classeur DémoOutIdx.
Ça ferait quand même beaucoup moins de programmation

P.S. J'ai commencé à l'écrire pour voir, à partir de ce que j'ai trouvé dans le code de votre Userform1.
Qu'est-ce qu'il faut mettre dans la procédure évènement Bingo ?
Non… rien. J'ai mélangé plusieurs classeurs…

Voilà :
VB:
Option Explicit
Dim WithEvents LesChoix As OutIdx.ComboBoxCasc
Dim Plage As Range, Ligne As Long

Private Sub UserForm_Initialize()
Set Plage = Application.Range(Feuil5.[A2], Feuil5.[A65000].End(xlUp)).EntireRow
Set LesChoix = OutIdx.CbxCasc
LesChoix.Add Me.ComboBox1, Plage.Columns("A")
LesChoix.Add Me.ComboBox2, Plage.Columns("B")
LesChoix.Add Me.ComboBox3, Plage.Columns("C")
LesChoix.Add Me.ComboBox4, Plage.Columns("K")
LesChoix.Actualiser
End Sub
'

Private Sub LesChoix_Bingo(Lignes() As Long)
Me.CommandButton1.Enabled = True
End Sub
'

Private Sub LesChoix_Défait()
Me.CommandButton1.Enabled = False
End Sub
'

Private Sub CommandButton1_Click()
Dim Num As Long
Num = Sheets("Reception").Range("A65536").End(xlUp).Row + 1
Sheets("Reception").Activate
Range("A" & Num).Value = TextBox1
Range("B" & Num).Value = ComboBox1
Range("C" & Num).Value = ComboBox2
Range("D" & Num).Value = ComboBox3
Range("E" & Num).Value = ComboBox4
Range("F" & Num).Value = CDbl(TextBox2)
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub
Remarque: il y aurait peut être intérêt à mettre les propriétés MatchRequired des ComboBox à True, et/ou à préciser un paramètre quelconque au Set LesChoix = OutIdx.CbxCasc("coul") pour voir facilement les mal renseignés. La classe ComboBoxCasc s'interdit d'effacer un ComboBox s'il a sa propriété MatchRequired à False, afin de permettre d'éventuels ajouts de nouveaux articles.
À +
 
Dernière édition:

Discussions similaires

Réponses
12
Affichages
423

Statistiques des forums

Discussions
314 450
Messages
2 109 719
Membres
110 551
dernier inscrit
Khyolyanna