Comboboxs en cascades avec conditions

A

alexvol

XLDnaute Nouveau
Bonjour,

j'ai créé un userform avec 4 comboboxs successives sans difficulté en me servant d'un fichier dispo sur le site developpez.com. Seulement, il y a un petit dysfonctionnement. J'ai posté sur ce site mais pour l'instant pas de nouvelles. Voilà pourquoi je poste aujourd'hui.

Voilà le problème : les comboboxs ne sont liées que 2 à 2...

Je voudrai que la 3ème combobox dépende à la fois de la première puis de la deuxième.

Je vous joins un fichier exemple avec une illustration de ce que je souhaite pour une meilleure compréhension.

Merci pour l'aide que vous pourrez m'apporter
 

Pièces jointes

  • demandeAide.xlsm
    70.7 KB · Affichages: 59
Trier par date Trier par votes
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Comboboxs en cascades avec conditions

Alors je vous joins une 1ère version équipée des modules nécessaires qui fait ce que vous demandez.
P.S. Remarquez: si on ne doit pas pouvoir entrer autre chose que ce qui est prévu dans la liste il vaudrait mieux passer les propriétés MatchRequired des ComboBox à True
À +
 

Pièces jointes

  • CbxCascVéhicul.xls
    171 KB · Affichages: 61
  • CbxCascVéhicul.xls
    171 KB · Affichages: 65
  • CbxCascVéhicul.xls
    171 KB · Affichages: 59
Dernière édition:
Vote positif 0 Vote négatif
A

alexvol

XLDnaute Nouveau
Re : Comboboxs en cascades avec conditions

Merci de cet exemple mais :
- sur quoi puis je intervenir pour atteindre mon réel objectif : 10 comboboxs successives ?
- et surtout quand je veix tester le userform, j'ai une erreur comme quoi lil me manque une librairie, "microsoft scripting runtime". Je suis sous mac. Est-ce la raison ?
Encore merci de prendre du temps pour moi
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Comboboxs en cascades avec conditions

Aïe! Effectivement là il y a un problème. On ne peut vraiment pas utiliser de Dictionary sous Mac ?
P.S. Remarquez, à la limite … on pourrait l'écrire !

Bonne nouvelle: je n'utilise pas toutes les possibilités des Dictionary dans mon système, au point que la classe Dictionary était très facile à écrire pour ce dont j'avais besoin. Mais il va peut être encore y avoir un problème dans le module TableIndex. Il suffira d'y passer:
VB: 
#Const AvecMoveMemory = 0

À +
 

Pièces jointes

  • CbxCascVéhicul.xls
    194 KB · Affichages: 84
  • CbxCascVéhicul.xls
    194 KB · Affichages: 68
  • CbxCascVéhicul.xls
    194 KB · Affichages: 60
Dernière édition:
Vote positif 0 Vote négatif
A

alexvol

XLDnaute Nouveau
Re : Comboboxs en cascades avec conditions

Bonjour,

je n'avais pas vu l'édition de votre dernier message. Je viens de le tester. Mais cela ne fonctionne pas :
- quand je lance le fichier, j'ai toutes les fenêtres vba qui s'affichent. Une ligne est en rouge :

Code: 
Private Declare PtrSafe Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
   (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)"

- quand je clique sur le bouton pour lancer le userform, il m'indique une erreur, n°53. Le clic sur "débogage" provoque un crash de l'application...

Merci de votre aide.
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Comboboxs en cascades avec conditions

Bonjour.
Je m'y attendais un peu (en fin pas au crash de l'application tout de même). S'il n'y a pas non plus moyen sous Macintosh d'utiliser une procédure système capable d’effectuer des mouvements massifs en mémoire, passez la constante de compilation AvecMoveMemory à 0 devant, pour que cette partie ne soit plus compilée. Une solution de rechange est prévue plus bas.
À +
 
Vote positif 0 Vote négatif
L

laetitia90

XLDnaute Barbatruc
Re : Comboboxs en cascades avec conditions

bonjour alexvol ,Dranreb:)
si mac accepte une collection on peut peu être partir la dessus
un code que j'utilisais avant de connaitre Dictionary bien moins rapide mais bon :(

Code: 
Dim T, z As Variant, l As Collection, i As Long
Private Sub UserForm_Initialize()
 On Error Resume Next
 Set l = New Collection
 T = Range("a2:e" & Cells(Rows.Count, 1).End(xlUp).Row)
 For i = LBound(T) To UBound(T)
 l.Add T(i, 1), T(i, 1)
 Next
 For Each z In l
 ComboBox1.AddItem z
 Next
End Sub
Private Sub ComboBox1_Change()
 On Error Resume Next
 Set l = New Collection
 T = Range("a2:e" & Cells(Rows.Count, 1).End(xlUp).Row)
 For i = LBound(T) To UBound(T)
 If T(i, 1) = ComboBox1 Then l.Add T(i, 2), T(i, 2)
 Next
 For Each z In l
 ComboBox2.AddItem z
 Next
End Sub
Private Sub ComboBox2_Change()
 On Error Resume Next
 Set l = New Collection
 T = Range("a2:e" & Cells(Rows.Count, 1).End(xlUp).Row)
 For i = LBound(T) To UBound(T)
 If T(i, 1) = ComboBox1 And T(i, 2) = ComboBox2 Then l.Add T(i, 3), T(i, 3)
 Next
 For Each z In l
 ComboBox3.AddItem z
 Next
End Sub

apres il faut simplifier tout cela avec un tablo pour simplifier le code mais bon

Les modules de OutIdx sont parfaits pour ça.
Cliquez pour agrandir...

trop trop bien ton "truc" Dranreb:)
pas facile a comprendre enfin pour moi !!! les possibilitées sont enorme encore bravo
a+


ps aprés il reste le code brut

Code: 
Private Sub UserForm_Initialize()
 Dim c As Range
For Each c In Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
 ComboBox1 = c
If ComboBox1.ListIndex = -1 And ComboBox1 <> "" Then ComboBox1.AddItem c
Next c
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
A

alexvol

XLDnaute Nouveau
Re : Comboboxs en cascades avec conditions

Merci de cette proposition qui fonctionne parfaitement et qui me semble simple d'utilisation.

Juste deux questions :
- à quoi correspond une "collection" ?
- pourquoi avoir ajouté le PS avec ce code brut ?

Encore merci
 
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Comboboxs en cascades avec conditions

Bonjour,

Voir PJ

Code: 
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("parametres")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    mondico(C.Value) = ""
  Next C
  Me.ComboBox1.List = mondico.keys
End Sub

Private Sub ComboBox1_click()
  Me.ComboBox2.Clear
  Me.ComboBox3.Clear
  Me.ComboBox4.Clear
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If C = Me.ComboBox1 Then mondico(C.Offset(, 1).Value) = ""
  Next C
  Me.ComboBox2.List = mondico.keys
End Sub

Private Sub ComboBox2_click()
  Me.ComboBox3.Clear
  Me.ComboBox4.Clear
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If C = Me.ComboBox1 And C.Offset(, 1) = Me.ComboBox2 Then mondico(C.Offset(, 2).Value) = ""
  Next C
  Me.ComboBox3.List = mondico.keys
End Sub

Private Sub ComboBox3_click()
  Me.ComboBox4.Clear
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If C = Me.ComboBox1 And C.Offset(, 1) = Me.ComboBox2 And C.Offset(, 2).Value = Me.ComboBox3 Then mondico(C.Offset(, 3).Value) = ""
  Next C
  Me.ComboBox4.List = mondico.keys
End Sub

Private Sub ComboBox4_click()
  Me.ComboBox5.Clear
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If C = Me.ComboBox1 And C.Offset(, 1) = Me.ComboBox2 And C.Offset(, 2).Value = Me.ComboBox3 And C.Offset(, 3).Value = Me.ComboBox4 Then mondico(C.Offset(, 4).Value) = ""
  Next C
  Me.ComboBox5.List = mondico.keys
End Sub

JB
 

Pièces jointes

  • Copie de demandeAide.xlsm
    27.9 KB · Affichages: 50
  • FormCascade5niveauxRapide.xlsm
    29.6 KB · Affichages: 62
Dernière édition:
Vote positif 0 Vote négatif
H

Habitude

XLDnaute Accro
Re : Comboboxs en cascades avec conditions

Bonjour à tous

Pour un peu plus de performance.

Contribution avec Indexation des Ranges
Contribution Oritenté Objet
 

Pièces jointes

  • alexvolIndexation.xlsm
    39.1 KB · Affichages: 50
  • alexvolPOO.xlsm
    53.7 KB · Affichages: 53
Vote positif 0 Vote négatif
A

alexvol

XLDnaute Nouveau
Re : Comboboxs en cascades avec conditions

Merci pour la proposition mais sous mac, cela ne fonctionne pas.

BOISGONTIER à dit:
Bonjour,

Voir PJ

Code: 
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("parametres")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    mondico(C.Value) = ""
  Next C
  Me.ComboBox1.List = mondico.keys
End Sub

Private Sub ComboBox1_click()
  Me.ComboBox2.Clear
  Me.ComboBox3.Clear
  Me.ComboBox4.Clear
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If C = Me.ComboBox1 Then mondico(C.Offset(, 1).Value) = ""
  Next C
  Me.ComboBox2.List = mondico.keys
End Sub

Private Sub ComboBox2_click()
  Me.ComboBox3.Clear
  Me.ComboBox4.Clear
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If C = Me.ComboBox1 And C.Offset(, 1) = Me.ComboBox2 Then mondico(C.Offset(, 2).Value) = ""
  Next C
  Me.ComboBox3.List = mondico.keys
End Sub

Private Sub ComboBox3_click()
  Me.ComboBox4.Clear
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If C = Me.ComboBox1 And C.Offset(, 1) = Me.ComboBox2 And C.Offset(, 2).Value = Me.ComboBox3 Then mondico(C.Offset(, 3).Value) = ""
  Next C
  Me.ComboBox4.List = mondico.keys
End Sub

Private Sub ComboBox4_click()
  Me.ComboBox5.Clear
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If C = Me.ComboBox1 And C.Offset(, 1) = Me.ComboBox2 And C.Offset(, 2).Value = Me.ComboBox3 And C.Offset(, 3).Value = Me.ComboBox4 Then mondico(C.Offset(, 4).Value) = ""
  Next C
  Me.ComboBox5.List = mondico.keys
End Sub

JB
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Comboboxs en cascades avec conditions

Bonsoir
Qu'est ce que vous attendez pour me demander comment on exploite les choix dans les ComboBox avec mon système hyper-simple et qui marche ?
Dans votre userform vous sélectionnez l'objet Casc dans la liste de gauche qui surmonte la fenêtre de code.
Vous avez trois évènements à votre disposition : Bingo, BingoUn et Défait. Il suffit d'implanter les procédures à l'aide de la liste de droite, exactement comme pour n'importe quelle autre procédure évènement telle que Workheet_Change par exemple.
P.S. ou plutôt comme ComboBoxX_Change, puisqu'on est dans un userform là.
À +
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
XL 2016 insertion ligne avec formule protégée et masquée
Réponses
7
Affichages
424
sylvanu
sylvanu
T
  • Question
Microsoft 365 Planning de réservation de matériel (avec gestion des stocks) - Formules utiles ?
Réponses
7
Affichages
2 K
vgendron
vgendron
D
  • Question
XL 2016 Mettre en couleur des images avec VBA
2
Réponses
26
Affichages
3 K
Dorileo
D
S
  • Question
XL 2010 VBA - macro avec 1 boucle qui alterne 1 action à conditions et 1 action sans conditions
2 3 4
Réponses
58
Affichages
6 K
Scorp0211
S
Usine à gaz
  • Résolu(e)
Microsoft 365 envoyer par boucle en 1 seul clic les sms du jour
Réponses
4
Affichages
1 K
Dudu2
Dudu2
S
  • Question
XL 2010 Aide actualisation TCD avec Combobox
Réponses
14
Affichages
2 K
safranien
S
K
  • Question
XL 2013 [VBA] Fonction Si CELLULE="Remplissage incolore", alors "OUI", sinon "NON
Réponses
7
Affichages
2 K
Cath987
C
L
  • Question
Calcul nombre de jours avec Conditions suite
Réponses
2
Affichages
914
lupars
L
H
  • Question
récup cellule d'une feuille en fonction jour de date dans une autre feuille
Réponses
2
Affichages
893
hds45
H
L
  • Question
Défilement liste formulaire
Réponses
4
Affichages
872
laryngo19
L

Membres actuellement en ligne

12 membres et 153 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 469
Messages
2 088 695
Membres
103 922
dernier inscrit
hhhh