Discussion :

[jbaudin]

Gestion plus avancée pour l'insertion de données provenant de différentes tables vers une table en particulier.

Permet de miniser le code d'insertion dans un module et d'avoir une gestion d'erreur globale lors de l'insertion.

Exemple :
On veut inserer dans une table des données qui viennent de plusieurs autres tables.
Si toutes les données sont correctes, tout va bien, mais lors d'une erreur, ça devient vite galère de gérer tout ça.
Ce code permet de produire une table avec des messages d'erreurs compréhensibles pour des non informaticiens. (faut bien penser à eux les pauvres petits ;-) )

"Pensez à cocher Microsoft DAO 3.6 object library dans les références : depuis un module faites Outils/Références."
http://access.developpez.com/faq/?pa...lds#NomChpsTbl

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
 
Option Compare Database
Option Explicit
 
'Utilisé par tous les modules pour récupérer un message d'erreur compréhensible
Public gstrErrMsgPerso As String
 
'---------------------------------------------------------------------------------------
' Procédure   : fctRecherche
' Description : Fonction de récupération d'une donnée
'               Retourne la valeur trouvée
' Paramètres  :
'               strTablePrimaire       : Nom de la table dans laquelle on recherche la valeur
'               strChamps              : Nom du champs recherché
'               strNomVal              : Nom du champs qui contient la valeur de sélection
'               strVal                 : Valeur du champs de sélection
'               strTableJoint          : Nom de la table de jointure
'               strChampsJoint         : Nom du champs de la table de jointure
'               strChampsJointPrimaire : Nom du champs de la table primaire pour la jointure
'               boolGroupBy            : True ou False pour spécifier si la requête doit comporter
'                                        un GroupBy
'               strChampsGroupBy       : Noms des champs avec la table si nécessaire pour le regroupement
'                                        Attention, séparés par des ; sans espace
'                                        ex : "MaTable.Champs;MaTable2.Champs2"
'               strCommentaire         : Commentaire libre pour la gestion d'erreur.
 
'               strModule              : Module appelant la fonction. Utile dans les messages d'erreurs
'               strTable               : Table en cours de remplissage. Utile dans les messages d'erreurs
'
'Exemple
'Sans jointure :
'       SELECT Champs_A_Retourner FROM MaTable WHERE Champs_De_Selection = Valeur_champs_de_selection
'       fctRecherche("MaTable", "Champs_A_Retourner", "Champs_De_Selection", "Valeur_champs_de_selection")
'
'Avec jointure :
'       SELECT Table_Jointure.Champs_A_Retourner FROM MaTable LEFT JOIN Table_Jointure ON MaTable.Champs_Jointure_MaTable = Table_Jointure.Champs_Jointure_Table_Jointure WHERE (((MaTable.Champs_De_Selection)="Valeur_champs_de_selection"));
'       fctRecherche("MaTable", "Champs_A_Retourner", "Champs_De_Selection", "Valeur_champs_de_selection", "Table_Jointure", "Champs_Jointure_Table_Jointure", "Champs_Jointure_MaTable")
'
'---------------------------------------------------------------------------------------
'
Public Function fctRecherche(strTablePrimaire As String, strChamps As String, strNomVal As String, strVal As String, Optional strTableJoint As String, Optional strChampsJoint As String, Optional strChampsJointPrimaire As String, Optional boolGroupBy As Boolean = False, Optional strChampsGroupBy As String, Optional strCommentaire As String, Optional strModule As String, Optional strTable As String) As String
 
    gstrErrFonction = "fctRecherche"
    Dim strRSTemp As Recordset
    Dim strSQLTemp As String
    Dim strValeur As String
    Dim strVerif As String
    Dim tblChampsGroupBy() As String
    Dim i As Integer
 
    fctRecherche = ""
 
    gstrErrMsgPerso = "Paramètres : " & strTablePrimaire & " ; " & strChamps & " ; " & strNomVal & " ; " & strVal & " ; " & strTableJoint & " ; " & strChampsJoint & " ; " & strChampsJointPrimaire & " ; " & boolGroupBy & " ; " & strChampsGroupBy
 
    If strVal <> "" Then
        'Vérification si tous ou aucun des paramètres optional sont renseignés
        strVerif = ""
        If strTableJoint <> "" Then strVerif = strVerif & "1" Else strVerif = strVerif & "0"
        If strChampsJoint <> "" Then strVerif = strVerif & "1" Else strVerif = strVerif & "0"
        If strChampsJointPrimaire <> "" Then strVerif = strVerif & "1" Else strVerif = strVerif & "0"
 
        If strVerif <> "000" And strVerif <> "111" Then
            gstrErrMsgPerso = "Mauvaise utilisation de la fonction fctRecherche. Code strVerif : " & strVerif & " - " & gstrErrMsgPerso
            'Gestion de l'erreur qui récupère gstrErrMsgClair
            Exit Function
        End If
 
        If strVerif = "000" Then 'Pas de paramètres optional
            'Requête simple
            strSQLTemp = "SELECT " & strChamps & " FROM " & strTablePrimaire
        ElseIf strVerif = "111" Then 'Paramètres optional présents
            'Création de la jointure
            strSQLTemp = "SELECT " & strTableJoint & "." & strChamps & " FROM " & strTablePrimaire
            strSQLTemp = strSQLTemp & " LEFT JOIN " & strTableJoint & " ON " & strTablePrimaire & "." & strChampsJointPrimaire & " = " & strTableJoint & "." & strChampsJoint
        Else
            gstrErrMsgPerso = "Mauvaise utilisation de la fonction fctRecherche. Code strVerif : " & strVerif & " - " & gstrErrMsgPerso
            'Ajouter la gestion de l'erreur qui récupère gstrErrMsgClair
            Exit Function
 
        End If
 
        'Si le champs est de type TEXTE, alors on encadre la valeur par "
            '10 : Texte
            '4  : Entier Long
            '7  : Réel Double
 
        If CurrentDb.TableDefs(strTablePrimaire).Fields(strNomVal).Type = 10 Then
            strVal = """" & strVal & """"
        End If
 
        If boolGroupBy Then
            strSQLTemp = strSQLTemp & " GROUP BY "
            tblChampsGroupBy = fctSplit(strChampsGroupBy, ";")
 
            i = 0
            While tblChampsGroupBy(i) <> ""
                strSQLTemp = strSQLTemp & tblChampsGroupBy(i)
                If tblChampsGroupBy(i + 1) <> "" Then strSQLTemp = strSQLTemp & ", "
                DoEvents
                i = i + 1
            Wend
            strSQLTemp = strSQLTemp & " HAVING (((" & strTablePrimaire & "." & strNomVal & ")=" & strVal & "));"
        Else
            strSQLTemp = strSQLTemp & " WHERE (((" & strTablePrimaire & "." & strNomVal & ")=" & strVal & "));"
        End If
        gstrErrSQL = strSQLTemp
 
    Else
        gstrErrMsgClair = strCommentaire & " Le champs " & strNomVal & " de la table (" & strTablePrimaire & ") n'est pas renseigné."
        'Ajouter la gestion de l'erreur qui récupère gstrErrMsgClair
        Exit Function
    End If
    'Création de la requête terminée
 
    'Remplissage du recordset
    Set strRSTemp = CurrentDb.OpenRecordset(strSQLTemp)
 
    'Gestion des erreurs
    If strRSTemp.RecordCount > 0 Then
        'Toujours pour savoir le nb exacte d'enregistrements
        strRSTemp.MoveLast
        strRSTemp.MoveFirst
 
        If strRSTemp.RecordCount > 1 Then
            If strVerif = "111" Then
                'Message pour une requête avec jointure
                gstrErrMsgClair = strCommentaire & " Le champs " & strChampsJointPrimaire & " de la table " & strTablePrimaire & " renvoie plusieurs enregistrements de la table : " & strTableJoint & " pour le champs " & strChamps & " avec " & strNomVal & " de la table " & strTablePrimaire & " = " & strVal
            Else
                'Message pour une requête simple
                gstrErrMsgClair = strCommentaire & " Plusieurs enregistrements dans la table : " & strTablePrimaire & " sur le champs " & strChamps & " avec " & strNomVal & " = " & strVal
            End If
            'Ajouter la gestion de l'erreur qui récupère gstrErrMsgClair
            strValeur = ""
        Else
            'Vérification si la valeur est nulle ou pas
            If strRSTemp.Fields(strChamps) <> "" Then
                strValeur = strRSTemp.Fields(strChamps)
            Else
                gstrErrMsgClair = strCommentaire & " Aucune donnée trouvée pour " & strNomVal & " = " & strVal & " dans la table " & strTablePrimaire
                'Ajouter la gestion de l'erreur qui récupère gstrErrMsgClair
                strValeur = ""
            End If
        End If
    Else
        gstrErrMsgClair = strCommentaire & " Le champs " & strChamps & " de la table " & strTablePrimaire & " n'est pas renseigné pour " & strNomVal & " = " & strVal
        'Ajouter la gestion de l'erreur qui récupère gstrErrMsgClair
        strValeur = ""
    End If
 
    fctRecherche = strValeur
 
End Function

[jbaudin]

C'est bizard, il me semblait avoir mis ce message dans " [Sources] Vos idées de codes sources pour Access nous intéressent !"
(http://www.developpez.net/forums/vie...ht=type+champs)
Pourquoi c'est pas au bon endroit ???????
J'ai du louper qq chose encore une fois.

[cafeine]

je passe ton message en statut [sources], la personne responsable de cette rubrique ne manquera pas de l'ajouter ou de te prévenir si ce n'est pas le cas.

Merci de ta contribution