Salut à tous,
J'aimerais quelques idées de plus sur mon problème, je travail sur une BD access. J'ai un sous-formulaire implanté sur un formulaire de tel sorte que j'obtiens un tableau qui m'affichera les enregistrements de ma BD que je pourrais les filtrer en cliquant sur chaque colonne de mon tableau. Le sous-formulaire est créé à partir d'une requête.
Voici mes codes VBA:
Sur un module, je déclare:
Sur le Formulaire principal, j'ai ça:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10 Option Compare Database Option Explicit Public Const cstSourceFiltre As String = " SELECT Activite.TActivite, Intitule.TIntitule, Pilote.TPilote, Demandeur.TDemandeur, Cause.TCause, Action.TAction, Action.Type, Action.Close, DateRealise.TRealise, Service.TService, Ligne.TLigne, Poste.TPoste, Produit.TProduit, Delai.TDelai, " _ & "FROM ((((((((((Activite INNER JOIN Intitule ON Activite.NumActivite = Intitule.NumActivite) INNER JOIN Pilote ON Activite.NumActivite = Pilote.NumActivite) INNER JOIN Demandeur ON Pilote.NumDemandeur = Demandeur.NumDemandeur) INNER JOIN [Action] ON (Pilote.NumPilote = Action.NumPilote) AND (Intitule.NumIntitule = Action.NumIntitule)) INNER JOIN Cause ON Action.NumCause = Cause.NumCause) INNER JOIN DateRealise ON Pilote.NumRealise = DateRealise.NumRealise) INNER JOIN Delai ON Action.NumDelai = Delai.NumDelai) INNER JOIN Service ON Action.NumService = Service.NumService) INNER JOIN Ligne ON Intitule.NumLigne = Ligne.NumLigne) INNER JOIN Poste ON Ligne.NumLigne = Poste.NumLigne) INNER JOIN Produit ON Intitule.NumProduit = Produit.NumProduit;" Public p_strSqlWhere As String Public p_tabCriteres() As Variant Public p_intCompteur As Integer
Et sur le sous-formulaire:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Option Compare Database Option Explicit Private Sub btnEffacerLesCriteres_Click() ' Initialisation du formulaire InitialisationFormulaire End Sub Private Sub btnFermer_Click() ' Ferme le formulaire de filtre DoCmd.Close End Sub Private Sub Form_Open(Cancel As Integer) ' Initialisation du formulaire InitialisationFormulaire End Sub Sub InitialisationFormulaire() ' Initialisation des variables p_strSqlWhere = "" 'Réinitialisation du tableau Critères For p_intCompteur = 0 To UBound(p_tabCriteres, 2) p_tabCriteres(1, p_intCompteur) = "Pas de critère pour ce champ" Next ' Initialisation du sous formulaire et réinitialisation Me.Sous_Formulaire.Form.RecordSource = cstSourceFiltre Me.Sous_Formulaire.Requery End Sub Private Sub btnImprimerFiltre_Click() On Error GoTo Err_btnImprimerFiltre_Click Dim stDocName As String stDocName = "P_ListePersonnelFiltreeAvecCode" DoCmd.OpenReport stDocName, acPreview Exit_btnImprimerFiltre_Click: Exit Sub Err_btnImprimerFiltre_Click: MsgBox Err.Description Resume Exit_btnImprimerFiltre_Click End Sub
Problème: En lançant exécutant mon code, un message d'erreur apparait: "the SELECT statement includes a reserved word or an argument name that is misspelled or missing, or the punctuation is incorrect" en soulignant cette ligne de code
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Option Compare Database Option Explicit Function FiltreDonnees(ByVal strNomChamp As String, ByVal varValeurChamp As Variant) ' Teste le contenu du controle If IsNumeric(varValeurChamp) Then ' Initialisation du contenu de p_strSqlWhere sans ajout de quotes si le contenu est ALPHA If p_strSqlWhere = "" Then p_strSqlWhere = "WHERE " & strNomChamp & " = " & varValeurChamp Else p_strSqlWhere = p_strSqlWhere & " AND " & strNomChamp & " = " & varValeurChamp End If Else ' Initialisation du contenu de p_strSqlWhere avec ajout des quotes si le contenu est ALPHA If p_strSqlWhere = "" Then p_strSqlWhere = "WHERE " & strNomChamp & " = '" & varValeurChamp & "'" Else p_strSqlWhere = p_strSqlWhere & " AND " & strNomChamp & " = '" & varValeurChamp & "'" End If End If ' réactualisation du sous formulaire Me.RecordSource = cstSourceFiltre & p_strSqlWhere Me.Requery End Function Private Sub Form_Load() ' Déclaration de la variable Dim ctlEnCours As Control ' Redimensionnement du tableau ReDim p_tabCriteres(1, p_intCompteur) ' Boucle sur toutes les zones de textes pour affecter la procédure de filtrage sur l'évènements DoubleClic For Each ctlEnCours In Me.Controls If ctlEnCours.ControlType = acTextBox Then If left(ctlEnCours.Name, 3) <> "txt" Then ctlEnCours.Properties("onDblClick") = "=FiltreDonnees('" & ctlEnCours.Name & "' , '" & ctlEnCours.Name & "')" ' renseigne le tableau avec les noms de champs RemplirTabCriteres (ctlEnCours.Name) End If End If Next ctlEnCours ' Désactivation de la variable Set ctlEnCours = Nothing End Sub Sub RemplirTabCriteres(ByVal strNomChamp As String) ' On récupére les noms des champs dans un tableau avec comme valeur par défaut : "Pas de critère pour ce champ" If p_intCompteur > 0 Then ReDim Preserve p_tabCriteres(1, p_intCompteur) End If ' renseigne le tableau avec les noms de champs et la mention par défaut ' qui sera affiché dans l'état p_tabCriteres(0, p_intCompteur) = strNomChamp p_tabCriteres(1, p_intCompteur) = "Pas de critère pour ce champ" p_intCompteur = p_intCompteur + 1 End Sub
dans le formulaire principal. Une aide de votre part me fera avancer car ça un peu de temps que je suis sur ce problème
Code : Sélectionner tout - Visualiser dans une fenêtre à part Me.Sous_Formulaire.Form.RecordSource = cstSourceFiltre
Partager