Formulaire de recherche prêt à l'emploi by Fabrice CONSTANS

**Mendes_one** · 23/02/2006, 00h17

Bonsoir tout le monde,

Tout d'abord merci au créateur du tuto...
Alors voila plusieurs jours que je m'arrache les cheveux sur ce precieux formulaire.
Je ne comprends plus rien

Il me semble avoir tout fait correctement mais le formulaire ne me propose aucune de mes tables et donc aucun champ non plus

De plus, si je pousse le vis à cliquer sur le bouton rechercher j'obtiens une erreur "94 - utilisation incorrecte de Null" et une anomalie sur le Private Sub cmd_recherche_Click() à cette ligne :

Code :

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

strTable = Me.cbo_Table         ' recupère le nom de la table

Pour info, voici le code complet du 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
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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
Option Compare Database
Option Explicit
 
Private Sub cbo_champ_AfterUpdate()
If IsNull(Me.cbo_Table) Or IsNull(Me.cbo_Champ) Then
   Exit Sub     ' l'un des champs est vide
End If
 
' initialise les étiquettes de l'opérateur
Me.lbl_Etiq1.Visible = True
Me.lbl_Etiq2.Visible = True
Me.lbl_Etiq3.Visible = True
Me.lbl_Etiq4.Visible = True
Me.lbl_Etiq5.Visible = True
Me.opt_Ope1.Visible = True
Me.opt_Ope2.Visible = True
Me.opt_Ope3.Visible = True
Me.opt_Ope4.Visible = True
Me.opt_Ope5.Visible = True
Me.txt_critere.Visible = True
 
 
Select Case lf_GetTypeField(Me.cbo_Table, Me.cbo_Champ)  ' pour trouver le type du champs
 
 
    Case Is = dbBoolean     ' Booléen
         Me.lbl_TypeChamp.Caption = "Oui/Non"
         Me.lbl_Etiq1.Caption = "Oui"
         Me.lbl_Etiq2.Caption = "Non"
         Me.lbl_Etiq3.Visible = False   ' cache car inusité dans ce cas
         Me.lbl_Etiq4.Visible = False   ' idem
         Me.lbl_Etiq5.Visible = False   ' idem
         Me.opt_Ope3.Visible = False
         Me.opt_Ope4.Visible = False
         Me.opt_Ope5.Visible = False
         Me.txt_critere.Visible = False   ' pas de critere
 
    Case dbByte To dbBinary, dbLongBinary, dbGUID To dbVarBinary, dbNumeric To dbTimeStamp   ' Numériques / date
         Me.lbl_TypeChamp.Caption = "Numérique"
         Me.lbl_Etiq1.Caption = "Etre égale ="
         Me.lbl_Etiq2.Caption = "Etre supérieure >="
         Me.lbl_Etiq3.Caption = "Etre inférieure <="
         Me.lbl_Etiq4.Caption = "Etre différente <>"
         Me.lbl_Etiq5.Visible = False
         Me.opt_Ope5.Visible = False
 
    Case dbText, dbMemo, dbChar ' texte / mémo
         Me.lbl_TypeChamp.Caption = "Texte"
         Me.lbl_Etiq1.Caption = "Etre strictement identique"
         Me.lbl_Etiq2.Caption = "Commencer par la valeur"
         Me.lbl_Etiq3.Caption = "Contenir la valeur"
         Me.lbl_Etiq4.Caption = "Finir par la valeur"
         Me.lbl_Etiq5.Caption = "Pas contenir la valeur"
 
     Case Else
         Me.lbl_TypeChamp.Caption = "Cas non prévu " & lf_GetTypeField(Me.cbo_Table, Me.cbo_Champ)
 
End Select
End Sub
 
Private Sub cbo_table_AfterUpdate()
    Me.cbo_Champ.RowSource = Me.cbo_Table.Value
    Me.cbo_Champ.Requery
End Sub
 
Private Sub cmd_recherche_Click()
    Dim strTable As String, strField As String, strCriteria As String, strSql As String
    Dim Criter As Variant
 
    Dim intTypChamp As Integer
    Dim intOpeChamp As Integer
 
    strTable = Me.cbo_Table         ' recupère le nom de la table
    strField = Me.cbo_Champ         ' recupère le nom du champ
 
    intTypChamp = lf_GetTypeField(strTable, strField)  ' pour trouver le type du champs ...
    intOpeChamp = Me.opt_Recherche
 
    Select Case intTypChamp
 
       Case dbBoolean                       ' bool
            If intOpeChamp = 1 Then          ' oui
               strCriteria = strTable & "." & strField & "=-1"
            ElseIf intOpeChamp = 2 Then      ' non
               strCriteria = strTable & "." & strField & "=0"
            Else
               strCriteria = strTable & "." & strField & "=Null"
            End If
 
       Case dbByte To dbBinary, dbLongBinary, dbBigInt To dbVarBinary, dbNumeric To dbTimeStamp                  ' traite les numeriques
            strCriteria = Me.txt_critere
            ' traite la virgule si elle existe
            If InStr(1, Me.txt_critere, ",") > 0 Then strCriteria = Replace(Me.txt_critere, ",", ".", 1)
            ' pour les versions antérieure à la 2000
            'If InStr(1, Me.txt_critere, ",") > 0 Then strCriteria = Left(Me.txt_critere, InStr(1, Me.txt_critere, ",") - 1) & "." & Right(Me.txt_critere, InStr(1, Me.txt_critere, ","))
 
            If intTypChamp = dbDate And IsDate(Me.txt_critere) Then strCriteria = "#" & Me.txt_critere & "#"                   ' type champ = date
            ' rajoute les dièses
 
            If Not IsNull(Me.txt_critere) Then
               Select Case intOpeChamp                    ' numerique, date
                   Case 1 ' =
                        strCriteria = strTable & "." & strField & "=" & strCriteria
 
                   Case 2 ' >=
                        strCriteria = strTable & "." & strField & ">=" & strCriteria
 
                   Case 3 ' <=
                        strCriteria = strTable & "." & strField & "<=" & strCriteria
 
                   Case 4 '<>
                        strCriteria = strTable & "." & strField & "<>" & strCriteria
               End Select
            End If
 
       Case dbText, dbMemo, dbChar                      ' texte
            Select Case intOpeChamp
                  Case 1 ' strictement egal
                       strCriteria = strTable & "." & strField & " Like """ & Me.txt_critere & """"
                  Case 2 ' commence par
                       strCriteria = strTable & "." & strField & " Like """ & Me.txt_critere & "*"""
                  Case 3 ' contient
                       strCriteria = strTable & "." & strField & " Like ""*" & Me.txt_critere & "*"""
                  Case 4 ' fini par
                       strCriteria = strTable & "." & strField & " Like ""*" & Me.txt_critere & """"
                  Case 5 ' ne contient pas
                       strCriteria = "NOT (" & strTable & "." & strField & " Like ""*" & Me.txt_critere & "*"")"
           End Select
       Case Else
            MsgBox "Cas non prévu."
            Exit Sub
   End Select
    If Me.Opt_RechCourante And Not Len(Me.Lst_Resultat.RowSource) = 0 Then
   If Not Me.Lst_Resultat.RowSource Like "*FROM " & strTable & "*" Then
      MsgBox "La recherche précédente ne porte pas sur la même table que la recherche actuelle.", vbExclamation + vbOKOnly, "Erreur"
      Exit Sub
   End If
   strSql = Left(Me.Lst_Resultat.RowSource, Len(Me.Lst_Resultat.RowSource) - 3)
   strSql = strSql & " AND " & strCriteria & "));"
Else
   ' construit la rq sql
   strSql = "SELECT DISTINCTROW " & strTable & ".*"
   strSql = strSql + " FROM " & strTable
   strSql = strSql + " WHERE ((" & strCriteria & "));"
End If
 
 
    Me.Lst_Resultat.RowSource = strSql  ' affecte sql a lst_Resultat
    Me.Lst_Resultat.Requery             ' recalcule la liste
End Sub
 
Private Sub Form_Open(Cancel As Integer)
    ' crée la liste des tables
    If lf_GetTableList() = 0 Then
        MsgBox "Pas de tables dans cette application .", vbInformation + vbOKOnly, "Erreur"
        Cancel = True
    End If
End Sub

et ci-après celui du module :

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
Option Compare Database
Option Explicit
 
Function lf_GetTypeField(lfNameTbl As String, lfNameFld As String)
' Renvoie le numéro du type du champ
'lfNameTbl = nom de la table
'lfNameFld = nom du champ
 
    Dim dbs As Database             ' Objet de la base
    Dim tbl As TableDef             ' Objet de définition de table
 
    Set dbs = CurrentDb             ' ouvre la base courante
    Set tbl = dbs.TableDefs(lfNameTbl)  ' ouvre la définition table
 
    lf_GetTypeField = tbl.Fields(lfNameFld).Type  ' renvoie le type de champ
    Set tbl = Nothing               ' libération des objets
    Set dbs = Nothing
 
    Function lf_GetTableList()
' renseigne la table tbl_TemplstTbl
 
Dim qrs As TableDefs
Dim rst As DAO.Recordset
 
Dim strSql As String
Dim i As Integer, j As Integer
 
' efface la table temporaire
DoCmd.SetWarnings False
strSql = "Delete tbl_TempLstTbl.*"
strSql = strSql + " FROM tbl_TempLstTbl;"
DoCmd.RunSQL strSql
 
' rempli    la table temporaire
Set qrs = CurrentDb.TableDefs
Set rst = CurrentDb.OpenRecordset("tbl_TempLstTbl")
 
For i = 0 To qrs.Count - 1
    ' ecarte les tables temp et systeme
    If Not (qrs(i).Name Like "*Temp*") And Not (qrs(i).Name Like "Msys*") And Not (qrs(i).Name Like "*tmp*") Then
       rst.AddNew
       rst.Fields(0) = qrs(i).Name
       rst.Update
    End If
Next
lf_GetTableList = rst.RecordCount
 
rst.Close
Set rst = Nothing
Set qrs = Nothing
DoCmd.SetWarnings True
End Function

Vraiment je désespère et de fait je vous sollicite.
J'oubliais, je ne suis pas expert.
Par avance merci à tous.

Mendes.

**Arkham46** · 23/02/2006, 21h26

slt,

sur quelle ligne l'erreur??

**Mendes_one** · 23/02/2006, 21h40

sur cette ligne ci :

Code :

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

strTable = Me.cbo_Table         ' recupère le nom de la table

**Arkham46** · 23/02/2006, 23h01

ah oui c'était écrit mais les 46000 lignes de code m'ont fait détourner le regard...

bon s'il ne te propose aucune table alors cbo_table est null et c'est normal que ça plante

et si la liste des tables est vide c'est que tu ne l'a pas remplie...

regarde mieux la définition des champs du formulaire dans le tutoriel, il y est indiqué les paramètres de la liste à remplir

Formulaire de recherche prêt à l'emploi by Fabrice CONSTANS

Access

Discussions similaires

Partager

Partager