Liste en cascade excel par du code VBA
Bonjour, je voudrais créer une liste en cascade excel avec le code VBA et en alimentant cette liste par une requête de ma base de donnée ACCESS.
Pour une liste simple pas de souci cela fonctionne mais quand je commence à faire une présélection pour la liste en cascade ça ne marche plus et un message d'erreur apparait " erreur d'exécution aucune valeur donnée pour un ou plusieurs des paramètres requis"
Voici mon 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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
| Private Sub Worksheet_Activate()
Dim cnx As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Dim resultat As Variant
Dim Rcompte As Integer 'Nombre d'enregistrement recordset
'Création de la connexion
cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=*******.accdb;Persist Security Info=False;"
Set cmd.ActiveConnection = cnx
'Création de la commande
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT DISTINCT LibelleCategorieFormation, IDCategorieFormation FROM R_FormationExcel ORDER BY IDCategorieFormation"
'Execution de la commande
Set rst = cmd.Execute
'Compte le nombre d'enregistrement
Rcompte = rst.RecordCount
Debug.Print (Rcompte)
'Parcour des enregistrement
Do Until rst.EOF
resultat = resultat & rst("LibelleCategorieFormation") & ","
rst.MoveNext
'Debug.Print resultat
Loop
rst.MoveFirst
With Range("I5").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=resultat
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Rcompte = 0
Set rst = Nothing
Set cmd = Nothing
resultat = ""
'Création de la commande
Set cmd.ActiveConnection = cnx
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT * FROM R_FormationExcel WHERE LibelleCategorieFormation =" & Range("LibelleCategorieFormation")
'Execution de la commande
Set rst = cmd.Execute
'Compte le nombre d'enregistrement
Rcompte = rst.RecordCount
Debug.Print (Rcompte)
'Parcour des enregistrement
Do Until rst.EOF
resultat = resultat & rst("LibelleFormation") & ","
rst.MoveNext
Debug.Print resultat
Loop
rst.MoveFirst
'Range("LibelleFormationAjoutFormation") = ""
With Range("LibelleFormationAjoutFormation").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=resultat
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
cnx.Close
Set cnx = Nothing
Set rst = Nothing
Set cmd = Nothing
resultat = ""
End Sub |
Merci de votre aide.
