Pb VBA, GetTypeField

Version imprimable

Bonjour, je ne connais pas trop en programmation, j'ai trouvé un code comme ci-dessous, mais le problème c'est qu'il m'accepte pas le GetTypeField

En effet, je veux faire une recherche sur 2 tables, selon la table choisit, choisir le champ sur lequel l'utilisateur veut faire une recherche, et ensuite j'ai une zone de texte dans lequel, l'utilisateur écrit la valeur recherchée..

Code:

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
Private Sub CmdRech_Click()
Dim Sql As String                               ' contient la requête
Dim N_Field As String                           ' contient le nom du champ
Dim N_Table As String
Dim Criteria As String                          ' contient le critère
Dim typChamp As Integer                         ' contient le type de champ
 
 
If IsNull(Me.Lst_Champs) Or IsNull(Me.Critere) Then
   MsgBox "Choisissez un nom de champ et entrez la valeur.", vbExclamation, Me.Name
   Exit Sub     ' l'un des champs est vide
End If
 
N_Table = Me.Lst_Table                          ' récupération de la table
N_Field = Me.Lst_Champs                         ' récupération du nom du champ
Criteria = Me.Critere                           ' récupération du critère
 
typChamp = lf_GetTypeField(N_Table, N_Field)
OpeChamp = Me.T_Recherche
' traitement de l'opérateur
 
Select Case typChamp
 
       Case 1                            ' bool
           If OpeChamp = 1 Then          ' oui
              Criteria = N_Field & "=-1"
           ElseIf OpeChamp = 2 Then          ' non
              Criteria = N_Field & "=0"
           Else
              Criteria = N_Field & "=Null"
           End If
 
       Case 2 To 8, 20                  ' traite les numeriques
           ' traite la virgule
           If InStr(1, Criteria, ",") > 0 Then
              Criteria = Left(Criteria, InStr(1, Criteria, ",") - 1) _
                         & "." & Right(Criteria, InStr(1, Criteria, ","))
           End If
 
           If typChamp = 8 Then                    ' type champ = date
              If IsDate(Me.Critere) Then           ' critere = date
                 Criteria = "#" & Criteria & "#"   ' rajoute les dièses
              Else
                 MsgBox "Vous devez entrer une date du type jj/mm/aa (21/01/03).", vbExclamation, Me.Name
                 Exit Sub                          ' pas une date
              End If
           End If
 
           Select Case OpeChamp                    ' numerique, date
 
                   Case 1 ' =
                        Criteria = N_Field & "=" & Criteria
 
                   Case 2 ' >=
                        Criteria = N_Field & ">=" & Criteria
 
                   Case 3 ' <=
                        Criteria = N_Field & "<=" & Criteria
 
                   Case 4 '<>
                        Criteria = N_Field & "<>" & Criteria
            End Select
 
 
       Case 10, 12                     ' texte
 
           Select Case OpeChamp
                  Case 1 ' strictement egal
                       Criteria = N_Field & " Like """ & Criteria & """"
 
                  Case 2 ' commence par
                       Criteria = N_Field & " Like """ & Criteria & "*" & """"
 
                  Case 3 ' est contenu dans
                       Criteria = N_Field & " Like """ & "*" & Criteria & "*" & """"
 
                  Case 4 ' fini par
                       Criteria = N_Field & " Like """ & "*" & Criteria & """"
           End Select
 
       Case Else
           MsgBox "Cas non prévu !"
           Exit Sub
End Select
 
If Me.OptRechCourante And Not Len(Me.Lst_Resultat.RowSource) = 0 Then
   Sql = Left(Me.Lst_Resultat.RowSource, Len(Me.Lst_Resultat.RowSource) - 3)
   Sql = Sql & " AND " & N_Table & "." & Criteria & "));"
Else
   ' construit la rq sql
   Sql = "SELECT DISTINCTROW " & N_Table & ".*"
   Sql = Sql + " FROM " & N_Table
   Sql = Sql + " WHERE ((" & N_Table & "." & Criteria & "));"
End If
                        ' construit la requête sql*
Me.Lst_Resultat.RowSource = Sql             ' affecte sql a lst_result
Me.Lst_Resultat.Requery             ' rafraîchi la liste
 
End Sub

Code:

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
Private Sub Lst_Champs_AfterUpdate()
 
If IsNull(Me.Lst_Champs) Then
   MsgBox "Choisissez un nom de champ.", vbExclamation, Me.Name
   Exit Sub     ' l'un des champs est vide
End If
 
Me.Etiq1.Visible = True
Me.Etiq2.Visible = True
Me.Etiq3.Visible = True
Me.Etiq4.Visible = True
Me.Bouton1.Visible = True
Me.Bouton2.Visible = True
Me.Bouton3.Visible = True
Me.Bouton4.Visible = True
Me.Critere.Visible = True    ' pas de critere
Me.T_Recherche = 1           ' repositionne l'option 1
 
Select Case lf_GetTypeField(Me.Lst_Table, Me.Lst_Champs)   ' traite suivant le type du champ
    Case 0   ' vide null
         Me.Text_Champ.Caption = "Pas de données"
         Me.Etiq1.Visible = False
         Me.Etiq2.Visible = False
         Me.Etiq3.Visible = False     ' obsolete dans ce cas
         Me.Etiq4.Caption = False     ' cache
         Me.Bouton1.Visible = False
         Me.Bouton2.Visible = False
         Me.Bouton3.Visible = False
         Me.Bouton4.Visible = False
         Me.Critere.Visible = False   ' pas de critere
     Case 1
         Me.Text_Champ.Caption = "Oui/Non"
         Me.Etiq1.Caption = "Oui"
         Me.Etiq2.Caption = "Non"
         Me.Etiq3.Caption = "Aucun"
         Me.Etiq4.Caption = False     ' obsolete dans ce cas
         Me.Bouton4.Visible = False
         Me.Critere.Visible = False   ' pas de critere
     Case 2 To 8, 20
         ' numérique, Date
         Me.Text_Champ.Caption = "Numérique/Date"
         Me.Etiq1.Caption = "Etre égale ="
         Me.Etiq2.Caption = "Etre supérieure >="
         Me.Etiq3.Caption = "Etre inférieure <="
         Me.Etiq4.Caption = "Etre différente <>"
 
     Case 10 ' string
         Me.Text_Champ.Caption = "Texte"
         Me.Etiq1.Caption = "Etre strictement identique"
         Me.Etiq2.Caption = "Commencer par la valeur"
         Me.Etiq3.Caption = "Contenir la valeur"
         Me.Etiq4.Caption = "Finir par la valeur"
 
     Case 12
         Me.Text_Champ.Caption = "Mémo/Hyperlien"
         Me.Etiq3.Caption = "Contenir la valeur"
         Me.Etiq1.Visible = False
         Me.Etiq2.Visible = False
         Me.Etiq4.Visible = False
         Me.Bouton1.Visible = False
         Me.Bouton2.Visible = False
         Me.Bouton4.Visible = False
         Me.T_Recherche = 3             ' option 3
 
End Select
 
 
End Sub

Code:

1
2
3
4
Private Sub Lst_Table_AfterUpdate()
Me.Lst_Champs.RowSource = Me.Lst_Table
Me.Lst_Champs = Null
End Sub

C'est la programmation que j'ai trouvé...Je ne comprends pas beaucoup là-dedans...

Merci d'avance pour votre aide..j'en ai vraiment besoin !

23/05/2007, 14h34
Tofalu

De toute évidence il te manque cette fonction dans ton copier/coller ;)
23/05/2007, 14h36
Zilfi63

Citation:

Envoyé par Tofalu

De toute évidence il te manque cette fonction dans ton copier/coller ;)

Le collage est réussi avec succès :D mais c'est la GetTypeField qui ne va pas
Il me met en Jaune le

Code:

Private Sub Lst_Champs_AfterUpdate()
23/05/2007, 14h38
Invité

Bonjour

As-tu un contrôle qui s'appelle : "Lst_Champs" ?

Starec
23/05/2007, 14h42
Zilfi63

Oui, j'ai mis dans les propriétés les noms qui correspondraient à peu près à la programmation trouvée..

Quand je choisis le nom de la table, ya pas de soucis
Mais quand il faut choisir le champ pour effectuer la requête dynamiquement, il ne veut pas s'exécuter avec la Commande Recherche
23/05/2007, 14h51
Tofalu

Je persiste à dire que cette fonction get_type_field est absente de ton projet
23/05/2007, 14h52
Zilfi63

Citation:

Envoyé par Tofalu

Je persiste à dire que cette fonction get_type_field est absente de ton projet

Et je dois faire quoi en faite ?
23/05/2007, 14h52
Tofalu

Et bien la récupérer là où tu as trouvé tout ce morceau de code ;)
23/05/2007, 14h56
Zilfi63

Regarde, le code de départ il est comme dans le dossier suivant
23/05/2007, 14h59
Tofalu

Et ? ça fonctionne chez moi, enfin presque car la requête me semble fausse
23/05/2007, 14h59
Zilfi63

j'ai vu qu'elle y était à la base..je suis désolée..

Citation:

Function lf_GetTypeField(lfNameTbl, lfNameFld)
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

End Function

Mais cette fois-ci, c'est

Citation:

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

qui devient surligner en jaune

Il doit te manquer la référence Microsoft DAO, d'ailleurs les déclarations sont dangereuses.

Une bonne habitude :

Code:

1
2
3
4
5
6
7
8
9
10
Function lf_GetTypeField(lfNameTbl, lfNameFld)
Dim dbs As DAO.Database         ' Objet de la base
Dim tbl As DAO.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
 
End Function

Citation:
Envoyé par Tofalu
Il doit te manquer la référence Microsoft DAO, d'ailleurs les déclarations sont dangereuses.

Une bonne habitude :
Code:

1 2 3 4 5 6 7 8 9 10 Function lf_GetTypeField(lfNameTbl, lfNameFld) Dim dbs As DAO.Database ' Objet de la base Dim tbl As DAO.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 End Function
Si je copie/colle ça marchera cette fonction ?

Je suis vraiment nulle sérieusement..:aie:

23/05/2007, 15h05
Tofalu

il te faut quand même ajouter la référence Microsoft DAO à ton projet (cf la FAQ ou les tutos)
23/05/2007, 15h13
Zilfi63

merci beaucoup à vous deux, j'espère que je trouverai comment ajouter Microsoft DAO sur mon projet...

J pense que jvous dérangerez encore ! si j'ai un :bug:
23/05/2007, 16h40
Zilfi63

Oui Encore Moi

Cette fois-ci, c'est la sélection du champ qui pose problème
J'ai fais tout ce que disait le tutoriel

(http://loufab.developpez.com/recursivite/#LIX-B), mais dans la sélection du champ par rapport à la table j'ai l'erreur de compilation qui apparaît..

:oops:
24/05/2007, 20h24
NOODLE02

Ce que tu dois commencer par faire, c'est te familiariser avec l'éditeur de VBA. Si tu passes un peu de temps à cela, àa t'éviteras bien des cheveux gris et pas mal d egros mots.

La première chose que tu peux faire c'est mettre un point d'arrêt à la première ligne de code de ton programme (en cliquant dans la partie extrème gauche de le fenêtre VBA en regard de l'instruction à laquelle tu veux que le programme s'arrête).

Avec la touche F8 tu peux tracer pas à pas toutes les instructions de ton code

Dans le menu du haut, tu as un poste qui s'appelle "Debogage". Dans celui-ci tu as un poste qui s'appelle "Ajouter un espion" . Cette fonction te permet de visionner la valeur d'une variable pendant l'exécution de ton code.

Dans le menu du haut, le poste "affichage" comporte l'option "Fenêtre espion". Si cette fenêtre n'est pas ouverte, ce poste de menu te permet de l'ouvrir.

en traçant ton code tu devrai très vite trouver l'erreur.