Discussion :

[chougadosu]

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:

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

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
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

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
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

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

Me.Sous_Formulaire.Form.RecordSource = cstSourceFiltre

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

[f-leb]

Bonsoir,

en effet, un pt’it problème de ponctuation…

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

" SELECT Activite.TActivite, …blabla, Produit.TProduit, Delai.TDelai, " _

Après Delai.TDelai et surtout après la virgule, on devrait trouver le champ suivant du SELECT…

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

& "FROM ((((((((((Activite INNER JOIN … "

Et paf, c’est le champ FROM qui est trouvé…

[chougadosu]

Salut f-leb,
Merci pour l'attention que je porte à mon problème, je n'ai bien compris votre explication. Dans ma base les tables sont Activite, Produit, Delai,.... et TActivite, TProduit, TDelai sont des champs.
Même je change la disoposition comme celle-ci, l'erreur persiste:

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
 
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;"

Et lorsque j'essai d'exécuter cette requête sous Access, ça fonctionne normalement.

[f-leb]

re,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 & "Delai.TDelai, " _
 & "FROM ((((((((((Activite INNER JOIN ...

juste supprimer la virgule en rouge après Delai.TDelai

[chougadosu]

Salut f-leb,
Maintenant sur mon formulaire principal un tableau avec les différents enregistrements de la requête du sous-formulaire mais lorsque je clique sur une colonne de mon tableau pour qu'il fasse le filtrage, il ya un message d'erreur: l'expression sur double clic entrée comme paramètre de la propriété de type événement est à l'origine d'une erreur. Characters found after end of SQL statement.

[f-leb]

Bonjour,

encore un problème de ponctuation…

Characters found after end of SQL statement.

Caractères trouvés après la fin de l'instruction SQL. (Erreur 3142)
Vous avez entré des données après avoir utilisé un point-virgule dans l'instruction SQL. Par exemple, "SELECT * FROM table1; garbage" génèrera cette erreur. Pour éviter cette erreur, supprimez les caractères situés après le point-virgule.

Tu composes un code SQL par concaténation de chaînes de caractères à la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Me.RecordSource = cstSourceFiltre & p_strSqlWhere

or,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public Const cstSourceFiltre As String = " SELECT …  ON Intitule.NumProduit = Produit.NumProduit;"

Il faut supprimer le point-virgule et mettre un espace à la place.

[chougadosu]

Salut f-leb,
J'ai changé un peu la manière de filtrer les enregistrements de ma BD.
La dernière fois, j'utilisais un sous-formulaire créé à partir d'une requête. Je me suis rendu compte qu'il me sera difficile après une mise à jour de mes tables de la BD que le sous-formulaire en tienne compte. Pour cela, j'ai changé ma méthode, j'utilise maintenant un seul formulaire qui affiche un tableau et je veux qu'en cliquant sur une des collonnes selon le nom champs qu'il fasse un filtrage. Voici le 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
 
Option Compare Database
Dim oRst As DAO.Recordset  'Stocke le curseur
Dim intnbLus As Integer   'Stocke le nb d'enregistrements lus la dernière fois
 
'Bouton pour passer à l'enregistrement suivant
Private Sub BtSuivant_Click()
LectureVersLAvant
End Sub
 
'Bouton pour retourner à l'enregistrement précédent
Private Sub BtPrecedent_Click()
LectureVersLArriere
End Sub

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
 
'Chargement du formulaire lors de son ouverture et affichage de 14 premiers enregistrements
Private Sub Form_Load()
Dim oDb As DAO.Database
Dim ctlEnCours As Control
'Instancie la base de données
Set oDb = CurrentDb
'Ouvre le recordset
Set oRst = oDb.OpenRecordset("SELECT Demandeur.TDemandeur, Activite.TActivite, Intitule.TIntitule, Ligne.TLigne, Poste.TPoste, Cause.TCause, Action.TAction,  Action.Type,  Action.Close, Delai.TDelai,  Pilote.TPilote, DateRealise.TRealise,  Produit.TProduit, Service.TService FROM Demandeur, Activite, Intitule, Ligne, Poste, Cause, [Action], Delai, Pilote, DateRealise, Produit, Service WHERE Activite.NumActivite = Intitule.NumActivite AND Produit.NumProduit = Intitule.NumProduit AND Ligne.NumLigne = Intitule.NumLigne AND  Ligne.NumLigne = Poste.NumLigne AND Service.NumService = Action.NumService AND Pilote.NumPilote = Action.NumPilote AND Cause.NumCause = Action.NumCause AND Delai.NumDelai = Action.NumDelai AND Demandeur.NumDemandeur = Pilote.NumDemandeur AND DateRealise.NumRealise = Pilote.NumRealise AND Activite.NumActivite = Pilote.NumActivite ", dbOpenDynaset)
' 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, 2) <> "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
'Lit les 14 premiers
LectureVersLAvant
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Private Sub LectureVersLAvant()
On Error GoTo err
'oRst.Update (True)
RemplirZoneTexte oRst.GetRows(14)
Exit Sub
err:
'Si on est sur le dernier enregistrement
'alors ne rien faire, sinon avertir
If err.Number <> 3021 Then
 MsgBox "Une erreur est survenue pendant la lecture des données", vbCritical, "Erreur"
End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub LectureVersLArriere()
On Error GoTo err
'Recule du nombre d'enregistrements nécessaire
oRst.Move -1 * intnbLus - 14
RemplirZoneTexte oRst.GetRows(14)
Exit Sub
err:
Select Case err.Number
  'Si on a trop reculé alors, se positionner sur le premier
  Case 3021: oRst.MoveFirst
  'Sinon, Avertir
  Case Else: MsgBox "Une erreur est survenue pendant la lecture des données", vbCritical, "Erreur"
End Select
End Sub

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
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
 
Sub RemplirZoneTexte(Tableau As Variant)
Dim I As Integer
'Récupère le nombre d'enregistrements Lus
intnbLus = UBound(Tableau, 2) + 1
'affecte les valeurs aux zones de texte
For I = 0 To intnbLus - 1
  'Affiche le code Demandeur
  Controls("TDemandeur" & I + 1) = Tableau(0, I)
  Controls("TDemandeur" & I + 1).Visible = True
  'Affiche l'Activité
  Controls("TActivite" & I + 1) = Tableau(1, I)
  Controls("TActivite" & I + 1).Visible = True
 
  'Affiche l'intitulé
  Controls("TIntitule" & I + 1) = Tableau(2, I)
  Controls("TIntitule" & I + 1).Visible = True
 
  'Affiche la ligne
  Controls("TLigne" & I + 1) = Tableau(3, I)
  Controls("TLigne" & I + 1).Visible = True
 
  'Affiche le Poste
  Controls("TPoste" & I + 1) = Tableau(4, I)
  Controls("TPoste" & I + 1).Visible = True
 
  'Affiche la Cause
  Controls("TCause" & I + 1) = Tableau(5, I)
  Controls("TCause" & I + 1).Visible = True
 
  'Affiche l'Action
  Controls("TAction" & I + 1) = Tableau(6, I)
  Controls("TAction" & I + 1).Visible = True
 
  'Affiche le Type
  Controls("Type" & I + 1) = Tableau(7, I)
  Controls("Type" & I + 1).Visible = True
 
  'Affiche l'Action Close
  Controls("Close" & I + 1) = Tableau(8, I)
  Controls("Close" & I + 1).Visible = True
 
  'Affiche le Delai
  Controls("TDelai" & I + 1) = Tableau(9, I)
  Controls("TDelai" & I + 1).Visible = True
 
  'Affiche le Pilote
  Controls("TPilote" & I + 1) = Tableau(10, I)
  Controls("TPilote" & I + 1).Visible = True
 
  'Affiche la Date Realisée
  Controls("TRealise" & I + 1) = Tableau(11, I)
  Controls("TRealise" & I + 1).Visible = True
 
  'Affiche le Produit
  Controls("TProduit" & I + 1) = Tableau(12, I)
  Controls("TProduit" & I + 1).Visible = True
 
  'Affiche le Service
  Controls("TService" & I + 1) = Tableau(13, I)
  Controls("TService" & I + 1).Visible = True
 
Next I
'Masque les autres zones de textes
For I = intnbLus + 1 To 14
  'Masque le Demandeur
  Controls("TDemandeur" & I).Visible = False
  'Masque l'Activité
  Controls("TActivite" & I).Visible = False
  'Masque l'Intitulé
  Controls("TIntitule" & I).Visible = False
  'Masque la ligne
  Controls("TLigne" & I).Visible = False
  'Masque le Poste
  Controls("TPoste" & I).Visible = False
  'Masque la Cause
  Controls("TCause" & I).Visible = False
  'Masque l'Action
  Controls("TAction" & I).Visible = False
  'Masque le Type
  Controls("Type" & I).Visible = False
  'Masque l'Action Close
  Controls("Close" & I).Visible = False
  'Masque le Delai
  Controls("TDelai" & I).Visible = False
  'Masque le Pilote
  Controls("TPilote" & I).Visible = False
  'Masque la date Réalisée
  Controls("TRealise" & I).Visible = False
  'Masque le Produit
  Controls("TProduit" & I).Visible = False
  'Masque le Service
  Controls("TService" & I).Visible = False
 
Next I
End Sub

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
 
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 formulaire
    Me.RecordSource = cstSourceFiltre & p_strSqlWhere
    Me.Requery
End Function

Sur un module, je déclare:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Option Compare Database
Option Explicit
 
Public Const cstSourceFiltre As String = " SELECT Demandeur.TDemandeur, Activite.TActivite, Intitule.TIntitule, Ligne.TLigne, Poste.TPoste, Cause.TCause, Action.TAction,  Action.Type,  Action.Close, Delai.TDelai,  Pilote.TPilote, DateRealise.TRealise,  Produit.TProduit, Service.TService FROM Demandeur, Activite, Intitule, Ligne, Poste, Cause, [Action], Delai, Pilote, DateRealise, Produit, Service "
Public p_strSqlWhere As String

Mon soucis lorsque je double clique sur une des colonne sur mon tableau, voir sur le pièce jointe, il ya une fenêtre qui s'affiche "veuillez entrer une valeur de paramètre". Comment je peux remedier à ce problème. Merci pour votre aide