Filtre formulaire par case à cocher

[dj dim]

Hello le Forum,

Je suis en pleine galère avec Access ...

J'ai monté un formulaire de tri qui fonctionne parfaitement.

Le soucis c'est que je souhaite l'améliorer en rajoutant des critères qui seront déterminés par des cases à cocher ...

J'ai modifié mon code initial en rajoutant quelques lignes mais j'obtiens un message d'erreur :



Voici mon code initial :

' ---
' FONCTION DE RECHERCHE
' ---
Function Recherche()
Dim strFiltre As String


' Construction du filtre
On Error GoTo RechercheErreur


strFiltre = ""

If Not IsNull(Me![critere_Départ Pays]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Départ Pays] LIKE " & "'*" & Replace(Me![critere_Départ Pays], "'", "''") & "*'" & ")"
End If
If Not IsNull(Me![critere_Départ Département]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Départ Département] LIKE " & "'*" & Replace(Me![critere_Départ Département], "'", "''") & "*'" & ")"
End If
If Not IsNull(Me![critere_Départ Ville]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Départ Ville] LIKE " & "'*" & Replace(Me![critere_Départ Ville], "'", "''") & "*'" & ")"
End If
If Not IsNull(Me![critere_Arrivée Pays]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Arrivée Pays] LIKE " & "'*" & Replace(Me![critere_Arrivée Pays], "'", "''") & "*'" & ")"
End If
If Not IsNull(Me![critere_Arrivée Département]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Arrivée Département] LIKE " & "'*" & Replace(Me![critere_Arrivée Département], "'", "''") & "*'" & ")"
End If
If Not IsNull(Me![critere_Arrivée Ville]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Arrivée Ville] LIKE " & "'*" & Replace(Me![critere_Arrivée Ville], "'", "''") & "*'" & ")"
End If

If Not IsNull(Me![critere_Affrété]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Affrété Nom] LIKE " & "'*" & Replace(Me![critere_Affrété], "'", "''") & "*'" & ")"
End If

If Not IsNull(Me![critere_Client Nom]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Client Nom] LIKE " & "'*" & Replace(Me![critere_Client Nom], "'", "''") & "*'" & ")"
End If

If Not IsNull(Me![critere_Agence]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Société] LIKE " & "'*" & Replace(Me![critere_Agence], "'", "''") & "*'" & ")"
End If




' Application du filtre
With Me.sfmResultats.Form
    .Filter = strFiltre
    .FilterOn = True
End With



Exit Function

RechercheErreur:
    MsgBox "Erreur :" & Err.Description, vbExclamation, "Recherche"
    Exit Function
    
End Function

Code modifié :

Option Compare Database
Option Explicit


' ---
' FONCTION DE RECHERCHE
' ---
Function Recherche()
Dim strFiltre As String


' Construction du filtre
On Error GoTo RechercheErreur


strFiltre = ""

If Not IsNull(Me![critere_Départ Pays]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Départ Pays] LIKE " & "'*" & Replace(Me![critere_Départ Pays], "'", "''") & "*'" & ")"
End If
If Not IsNull(Me![critere_Départ Département]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Départ Département] LIKE " & "'*" & Replace(Me![critere_Départ Département], "'", "''") & "*'" & ")"
End If
If Not IsNull(Me![critere_Départ Ville]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Départ Ville] LIKE " & "'*" & Replace(Me![critere_Départ Ville], "'", "''") & "*'" & ")"
End If
If Not IsNull(Me![critere_Arrivée Pays]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Arrivée Pays] LIKE " & "'*" & Replace(Me![critere_Arrivée Pays], "'", "''") & "*'" & ")"
End If
If Not IsNull(Me![critere_Arrivée Département]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Arrivée Département] LIKE " & "'*" & Replace(Me![critere_Arrivée Département], "'", "''") & "*'" & ")"
End If
If Not IsNull(Me![critere_Arrivée Ville]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Arrivée Ville] LIKE " & "'*" & Replace(Me![critere_Arrivée Ville], "'", "''") & "*'" & ")"
End If

If Not IsNull(Me![critere_Affrété]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Affrété Nom] LIKE " & "'*" & Replace(Me![critere_Affrété], "'", "''") & "*'" & ")"
End If

If Not IsNull(Me![critere_Client Nom]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Client Nom] LIKE " & "'*" & Replace(Me![critere_Client Nom], "'", "''") & "*'" & ")"
End If

If Not IsNull(Me![critere_Agence]) Then
    If strFiltre <> "" Then strFiltre = strFiltre & " AND "
    strFiltre = strFiltre & "([Société] LIKE " & "'*" & Replace(Me![critere_Agence], "'", "''") & "*'" & ")"
End If


    If Me![Cocher37] Then
        strFiltre = strFiltre & " OR ([Activité] = 'Affrètement')"
    End If
    If Me![Cocher45] Then
        strFiltre = strFiltre & " OR ([Activité] = 'Départ/Arrivage')"
    End If
    If Me![Cocher47] Then
        strFiltre = strFiltre & " OR ([Activité] = 'Parc Propre')"
    End If
    If Len(strFiltre) > 0 Then
        strFiltre = Mid$(strFiltre, 4, Len(strFiltre) - 3)
    Else
        strFiltre = "[Activité] = 'Aucun des trois'"
    End If



' Application du filtre
With Me.sfmResultats.Form
    .Filter = strFiltre
    .FilterOn = True
End With




Exit Function

RechercheErreur:
    MsgBox "Erreur :" & Err.Description, vbExclamation, "Recherche"
    Exit Function
    
End Function

 

[Compte Supprimé 979]

Re : Filtre formulaire par case à cocher

Bonjour Dj'Dim

Je ne sais pas si tu as trouvé une réponse, mais sans fichier tu n'en auras pas ici ...
j'en ai bien peur

A+