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 97 98 99 100 101 102 103 104
|
Option Compare Database
Option Explicit
Private Enum RechercheOption
StrictementEgal = 1
CommencePar = 2
Contient = 3
FiniPar = 4
NeContientPas = 5
End Enum
Private Sub cmd_recherche_Click()
Call RafraichirListe
End Sub
Private Sub txt_critere_Exit(Cancel As Integer)
Call RafraichirListe
End Sub
Sub RafraichirListe()
Dim vntTable As Variant
Dim vntChamp As Variant
Dim OptionRecherche As RechercheOption
Dim strContenuSQL As String
Dim strMessage As String
Dim strControl As String
vntTable = Me.cbo_table
vntChamp = Me.cbo_champ
' on prend "Contient" si pas précisé
OptionRecherche = Nz(Me.opt_recherche, Contient)
If Chercher(Me.txt_critere, vntTable, vntChamp, OptionRecherche, strContenuSQL, strMessage, strControl) = True Then
MsgBox "Voici ce que j'ai trouvé...", vbInformation, "Recherche aboutie"
Else
MsgBox strMessage, vbExclamation, "Recherche échouée"
Me.Controls(strControl).SetFocus
End If
With Me.lst_resultat
.RowSource = strContenuSQL
.Requery
End With
End Sub
Private Function Chercher(ByVal Quoi As Variant, ByVal LaTable As Variant, LeChamp As Variant, ByVal OptionRecherche As RechercheOption, ByRef Contenu As String, ByRef Message As String, ByRef Controle As String) As Boolean
Dim strTable As String
Dim strField As String
Dim strCriteria As String
Dim oRS As DAO.Recordset
On Error GoTo ErreurChercher
Controle = "txt_critere"
If Len(Nz(Quoi, "")) = 0 Then
Message = "Vous devez indiquer un critère de recherche pour effectuer une recherche !"
err.Raise 13, "Valeur requise", Message
End If
If Len(Nz(LeChamp, "")) = 0 Then
Message = "Vous devez renseigner le champ pour effectuer une recherche !"
Controle = "cbo_champ"
err.Raise 94, "Valeur requise", Message
End If
If Len(Nz(LaTable, "")) = 0 Then
Message = "Vous devez renseigner la table pour effectuer une recherche !"
Controle = "cbo_table"
err.Raise 94, "Valeur requise", Message
End If
strTable = "[" & LaTable & "]"
strField = strTable & ".[" & LeChamp & "]"
Select Case Me.opt_recherche
Case StrictementEgal
strCriteria = strField & " Like '" & Quoi & "'"
Case CommencePar
strCriteria = strField & " Like '" & Quoi & "*'"
Case Contient
strCriteria = strField & " Like '*" & Quoi & "*'"
Case FiniPar
strCriteria = strField & " Like '*" & Quoi & "'"
Case NeContientPas
strCriteria = "NOT (" & strField & " Like '*" & Quoi & "*')"
End Select
Contenu = "SELECT DISTINCTROW * FROM " & strTable & " WHERE (" & strCriteria & ");"
Set oRS = CurrentDb.OpenRecordset(Contenu, dbOpenDynaset)
If Not oRS.EOF Then
Chercher = True
Else
Chercher = False
Contenu = "SELECT * FROM " & strTable & ";"
Message = "Il n'y a pas de données correspond au critère '" & Quoi & "' que vous avez tapé..."
err.Raise 3021, "Aucune correspondance", Message
End If
oRS.Close
On Error GoTo 0
SortieChercher:
Set oRS = Nothing
Exit Function
ErreurChercher:
Chercher = False
Resume SortieChercher
End Function |
Partager