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
| Public Sub SourceFmRechercheAtt()
Dim sSql As String
Dim sWhere As String
Dim ctl As Control
Dim q As QueryDef
'Partie fixe
sSql = "SELECT TbAtt.IDAtt, TbAtt.VEN, TbAtt.VENLie, TbAtt.NPage, TbAtt.Client, TbAtt.IDCodeAtt, TbAtt.IDActivite, TbAtt.DateAtt, TbAtt.IDCAFF, TbAtt.DLR, TbAtt.Origine, TbAtt.LieuW, TbAtt.LieuW2, TbAtt.Commune,"
sSql = sSql & "TbAtt.NomAbo, TbAtt.ND, TbAtt.IDTech, TbAtt.DebutW, TbAtt.FinW, TbAtt.NPoteau1, TbAtt.NPoteau2, TbAtt.NPoteau3, TbAtt.NPoteau4, TbAtt.NPoteau5, TbAtt.NPoteau6, TbAtt.HeuresW, TbAtt.IDEtatW, "
sSql = sSql & "TbAtt.NDecharge, TbAtt.CommentairesAtt, TbAtt.IDDetailAtt, TbAtt.IDMarche, TbAtt.IDEtatAtt, TbAtt.IDSR, TbCAFF.CAFF, TbEtatW.EtatW, TbEtatAtt.EtatAtt, TbCodeAtt.CodeAtt, TbTech.Nom "
sSql = sSql & "FROM TbTech RIGHT JOIN (TbEtatAtt RIGHT JOIN (TbEtatW RIGHT JOIN (TbCodeAtt RIGHT JOIN (TbCAFF RIGHT JOIN TbAtt ON TbCAFF.IDCAFF = TbAtt.IDCAFF) ON TbCodeAtt.IDCodeAtt = TbAtt.IDCodeAtt) ON "
sSql = sSql & "TbEtatW.IDEtatW = TbAtt.IDEtatW) ON TbEtatAtt.IDEtatAtt = TbAtt.IDEtatAtt) ON TbTech.IDTech = TbAtt.IDTech "
'Construction de la clause Where
'Une boucle sur chaque contrôle filtre, compléter la clause si le contrôle n'est pas null
For Each ctl In Me.Controls
If ctl.Name Like "*filtre*" And Not IsNull(ctl) Then
sWhere = sWhere & DLookup("Parametre", "TbFiltre", "Filtre=""" & ctl.Name & """") & " and "
End If
Next ctl
'Si on a trouvé des filtres, supprimer le dernier " and " et placer à la suite du sql. Sinon pas de clause Where
If Len(sWhere) <> 0 Then
sWhere = Left(sWhere, Len(sWhere) - 5)
'Y a-t-il une recherche sur "Poteau" ?
If sWhere Like "*poteau1*" Then
sWhere = sWhere & " or " & Replace(sWhere, "poteau1", "poteau2") _
& " or " & Replace(sWhere, "poteau1", "poteau3") _
& " or " & Replace(sWhere, "poteau1", "poteau4") _
& " or " & Replace(sWhere, "poteau1", "poteau5") _
& " or " & Replace(sWhere, "poteau1", "poteau6")
End If
'Terminer la clause Where (encadrer le code entre Where ( et )
sWhere = "Where (" & sWhere & ")"
sSql = sSql & sWhere
End If
'Placer le point-virgule final
sSql = sSql & ";"
'Modifier la requête r_FmRechercheAtt
Set q = CurrentDb.QueryDefs("r_FmRechercheAtt")
q.sql = sSql
'Affecter cette requête comme source du formulaire
Me.RecordSource = "r_FmRechercheAtt"
'Rafraîchir les listes
For Each ctl In Me.Controls
If ctl.Name Like "zdlfiltre*" Then
ctl.RowSource = ctl.RowSource
End If
Next ctl
End Sub |
Partager