Aide pour code remplissage Combo en cascade

Version imprimable

Bonjour à tous,

J'ai trouvé un code qui me permet de remplir une Combo (Combo_ListRecett) par rapport aux données d'une première Combo (Combo_Catég).

Citation:

http://boisgontierjacques.free.fr/pa...irecascade.htm

Je lui ai apporté les modifications nécessaires afin qu'il puisse être adapté à mon besoin, mais ça ne fonctionne pas.

Le message d'erreur suivant apparaît :

Citation:

Impossible de définir la propriété Value.
Le type ne correspond pas.

Donc à l'initialisation de mon Uf j'ai ce code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Private Sub UserForm_Initialize() Dim f, BD() 'On cache les Label à l'ouverture de l'UF Me.Pi1.Visible = False Me.Pi2.Visible = False Me.Pi3.Visible = False Me.Pi4.Visible = False Me.Et1.Visible = False Me.Et2.Visible = False Me.Et3.Visible = False Me.Et4.Visible = False Me.Et5.Visible = False Set f = Sheets("Recettes") BD = f.Range("A2:B" & f.[B65000].End(xlUp).Row).Value ' Array BD() pour rapidité Set d = CreateObject("Scripting.Dictionary") For i = 1 To UBound(BD) ' on explore la colonne 1 d(BD(i, 1)) = "" ' on ajoute l'élément de la famille au dictionnaire Next i Me.Combo_Catég = d.keys End Sub
Et celui-ci lorsque je clique sur le premier Combo (Combo_Catég)
Code:

1 2 3 4 5 6 7 Private Sub Combo_Catég_click() Me.Combo_ListRecett.Clear For i = 1 To UBound(BD) If BD(i, 1) = Me.Combo_Catég Then MeCombo_ListRecett.AddItem BD(i, 2) Next i End Sub
Pourriez-vous m'apporter votre aide s'il vous plait ?
Je vous en remercie par avance

Très cordialement

09/05/2019, 16h58
boisgontierjacques

Bonjour,

La BD est-elle vide?

Boisgontier
09/05/2019, 17h23
Vba14

Bonjour,

Non, mais je n'ai qu'une seule ligne d'essai.

1 pièce(s) jointe(s)

Exemple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim f, BD()
Private Sub UserForm_Initialize()
  Set f = Sheets("base")
  BD = f.Range("A2:B" & f.[A65000].End(xlUp).Row).Value   ' Array pour rapidité
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(BD)                                 ' on explore la colonne de niveau 1
    If BD(i, 1) <> "" Then d(BD(i, 1)) = ""                                   ' on ajoute l'élément de la famille au dictionnaire
  Next i
  Me.Famille.List = d.keys
End Sub
 
Private Sub Famille_click()
  Me.SousFamille.Clear
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(BD)           ' on explore la colonne de niveau 2
     If BD(i, 1) = Me.Famille Then d(BD(i, 2)) = "" ' si famille alors on ajoute l'élément de la sous-famille au dictionnaire
  Next i
  Me.SousFamille.List = d.keys
End Sub

Boisgontier

1 pièce(s) jointe(s)

Merci Jacques,

J'ai donc mis ton exemple en application selon mes besoins et ça donne ceci :
Cependant j'ai un message d'erreur dans le 2ème code, ligne 4 en gras, "Incompatibilité de type"
qu'ai-je fait qui ne convient pas ? ou pas fait ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Private Sub UserForm_Initialize()
Dim f, BD()
 
'On cache les Label à l'ouverture de l'UF
Me.Pi1.Visible = False
Me.Pi2.Visible = False
Me.Pi3.Visible = False
Me.Pi4.Visible = False
Me.Et1.Visible = False
Me.Et2.Visible = False
Me.Et3.Visible = False
Me.Et4.Visible = False
Me.Et5.Visible = False
 
  Set f = Sheets("Recettes")
  BD = f.Range("A2:B" & f.[A65000].End(xlUp).Row).Value   ' Array pour rapidité
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(BD)                                 ' on explore la colonne de niveau 1
    If BD(i, 1) <> "" Then d(BD(i, 1)) = ""               ' on ajoute l'élément de la famille au dictionnaire
  Next i
  Me.Combo_Catég.List = d.keys
End Sub

Code:

1
2
3
4
5
6
7
8
9
Private Sub combo_Catég_click()
  Me.Combo_ListRecett.Clear
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(BD)           ' on explore la colonne de niveau 2
     If BD(i, 1) = Me.Combo_Catég Then d(BD(i, 2)) = "" ' si famille alors on ajoute l'élément de la sous-famille au dictionnaire
  Next i
  Me.Combo_ListRecett.List = d.keys
End Sub

Voici le fichier en pièce jointe (en cours de réalisation)
Pièce jointe 473591

09/05/2019, 18h36
boisgontierjacques

1 pièce(s) jointe(s)

La déclaration de BD() n'était pas au bon endroit.

Boisgontier
09/05/2019, 18h47
Vba14

Merci beaucoup Jacques, je vais pouvoir continuer mon projet.
Je te souhaite une très bonne soirée

Très cordialement

René