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