I. Prérequis▲
Ce tutoriel s'adresse à des utilisateurs qui maitrisent déjà les bases du logiciel Access ou qui veulent faire l'effort pour progresser : l'utilisation du VBA décuple le potentiel de solutions !
Pour vérifier votre niveau, parcourez ces tutoriels : si vous les comprenez facilement, vous êtes OK et si ce n'est pas le cas, insistez :
- pour commencer : Maxence Hubiche Access - Les Bases ;
- pour construire des requêtes : Jean Ballat Créer des requêtes simples ;
- pour construire un formulaire :Jean-Philippe Ambrosino le chapitre 2-1-2 de Mise en surbrillance d'un enregistrement dans un formulaire ;
- pour le VBA : Olivier Lebeau Initiation au VBA Office.
D'une manière générale, pour vous documenter sur les propriétés d'un formulaire ou d'un état, ou de leurs contrôles :
- affichez l'objet en mode création ;
- cliquez sur la propriété, elle se met alors en surbrillance ;
- enfoncez la touche <F1>.
Pour un problème de code dans un module, placez le curseur sur le mot-clé du VBA et pressez <F1>.
L'aide Access s'ouvre alors à la bonne page.
On peut aussi :
- ouvrir l'aide <F1>, choisir l'onglet « Aide intuitive » et suivre les instructions ;
- ouvrir la fenêtre d'exécution (<Ctrl> + G), saisir un mot-clé, y placer le curseur de la souris et presser <F1>.
II. Contexte de l'application▲
II-A. Objectif▲
L'utilisateur de cette application est nutritionniste pour élevages de bovins laitiers.
Son travail : conseiller des éleveurs quant à la nourriture de leur troupeau. Aujourd'hui, dans un contexte de resserrement des marges, de fluctuation des prix de vente et d'augmentation du prix des intrants, produire un volume de lait ne suffit pas à faire le résultat, c'est la manière de le produire qui fait la différence !
Le principal poste de charge est indéniablement l'alimentation, c'est le premier facteur de rentabilité. De plus, sa maîtrise impacte l'ensemble des autres postes, santé, fécondité, durée de vie des animaux, coût du renouvellement…
L'objectif de cette application est de mettre en place un système pour stocker et interpréter les résultats des analyses mensuelles du lait produit par chacune des vaches de ses clients éleveurs.
II-B. Origine des données▲
Le résultat des analyses est fourni par des organismes tels que SYNel, Agranet…
L'éleveur peut y consulter le résultat de l'analyse sur un site.
À titre d'exemple :
Pour récupérer les données, SYNel propose le téléchargement d'un fichier .csv :
Pour Agranet, on copie-colle dans un fichier Excel :
II-C. Quelles sont les données utiles ?▲
II-C-1. Les coordonnées de l'éleveur▲
Les données habituelles (nom, adresse…), son N° d'éleveur et, pour des raisons propres à cette application, la date du dernier contrôle enregistré dans la base de données.
II-C-2. L'identité de la vache▲
Son nom, son N° de travail (qu'elle porte à l'oreille), sa race, son N° de lactation, les dates de ses vêlages.
II-C-3. L'historique des contrôles de la vache▲
La date, le N° du contrôle (recommence à 1 après chaque vêlage), la quantité de lait (en kilogrammes) produite lors du contrôle, la teneur en matière grasse (TB* sert principalement à la fabrication des crèmes et beurres), la teneur en matière protéique (TP* sert principalement à la fabrication des fromages).
* exprimé en grammes par litre de lait cru.
III. L'arborescence des fichiers▲
« Manuel », pour les quelques rares éleveurs qui communiquent les résultats en encodant une feuille Excel.
IV. Le modèle de données▲
et 
sont a priori redondants : le numéro de lactation d'une vache est égal au nombre de fois que cette vache a vêlé. Cependant, lorsqu'un éleveur devient client, il serait fastidieux d'encoder les dates de tous les vêlages de ses vaches d'autant plus que la valeur ajoutée de cette info est faible. Pour les traitements à venir, seule la date du dernier vêlage est indispensable.
Conclusion, on ne peut pas, dans tous les cas, dériver le N° de lactation du nombre d'enregistrements dans tVelages.
Ces données pourraient être recalculées quand elles s'avèrent nécessaires, mais par souci de facilité, le résultat du calcul est sauvegardé :
DureeLacta : nombre de jours entre la date du contrôle et le dernier vêlage ;
CumulLait : estimation de la quantité de lait (kg) produite depuis le dernier vêlage. Pour estimer la quantité entre deux contrôles, on prend la moyenne des quantités constatées lors de ces deux contrôles que l'on multiplie par le nombre de jours qui les séparent ;
MoyTB et MoyTP : estimation de la teneur en matière grasse et matière protéique de CumulLait ;
Lait7pc : CumulLait x (MoyTB + MoyTP) / 70.
Pense-bête. Aide-mémoire avec date et texte de la prise de notes au sujet d'un éleveur.
V. Le formulaire fVaches▲
V-A. Présentation▲
V-B. Sa source▲
V-C. fVaches a deux sous-formulaires fils : sfControles et sfVelages▲
Ces deux sous-formulaires sont de simples listes qui n'appellent pas d'autres commentaires.
Si la technique père/fils ne vous est pas familière, voyez ce tutoriel : Comment classer les données dans des tables liées et construire un formulaire père/fils
V-D. Explication du code associé à fVaches▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Option Compare Database
Option Explicit
Private Sub Form_Current()
'Gérer la couleur du contrôle caPresenceDerCtl
Me.caPresenceDerCtl = DCount("*", "rVLPresenteDernCtl")
If Me.caPresenceDerCtl = 1 Then 'Vache présente
Me.caPresenceDerCtl.BackColor = 52377 'vert
Else
Me.caPresenceDerCtl.BackColor = 52479 'orange
End If
End Sub
On règle ici le fonctionnement du groupe d'options caPresenceDerCtl :
On voudrait que ce groupe d'options indique la présence ou non de la vache lors du dernier contrôle enregistré et que sa couleur s'adapte.
Examinons ses propriétés :
Si on attribue 1 au groupe d'options caPresenceDer, le bouton d'options ccPresent sera coché.
Si on attribue 0 au groupe d'options caPresenceDer, le bouton d'options ccAbsente sera coché.
Or, à chaque lecture d'un enregistrement, on lui affecte DCount("*", "rVLPresenteDernCtl") c'est-à-dire le nombre d'enregistrements ramenés par la requête rVLPresenteDernCtl que voici :
Cette requête ramène soit un enregistrement, si cette vache était présente au dernier contrôle et zéro dans le cas contraire.
Aux instructions 7 et 9, on adapte la couleur par le code, car Access 2000 n'offre pas la possibilité de mise en forme conditionnelle pour un groupe d'options.
VI. Le formulaire fEleveurs▲
VI-A. Présentation▲
VI-B. Sa source▲
VI-C. Explication du code associé à fEleveurs▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Option Compare Database
Option Explicit
Private Sub cboEleveur_AfterUpdate()
'On cherche l'enregistrement qui contient cette valeur
Me.Recordset.FindFirst "tEleveursPK =" & Me.cboEleveur
End Sub
Private Sub Form_Current()
'Aménager le texte variable
'S'il s'agit de l'encodage d'un nouveau, on n'exécute pas ce code
If Me.NewRecord Then Exit Sub
'Pour les autres enregistrements, on construit le texte qui dénombre les vaches
Me.txtTroupeau = ": " _
& DCount("Presente", "rToutesVL", "Presente=-1 and tEleveursFK =" & Me.TXTtEleveursPK) _
& " actuellement, dont " _
& DCount("Nouvelle", "rToutesVL", "Nouvelle=-1 and tEleveursFK =" & Me.TXTtEleveursPK) _
& " nouvelle(s)"
End Sub
15-18 : on utilise la fonction de domaine Dcount() pour trouver le nombre de vaches de cet éleveur.
Voici la requête rToutesVL qui est sollicitée :
VI-D. Le sous-formulaire fils sfVachesEleveur▲
Sa source est la requête rToutesVL qui vient d'être décrite. En tant que fils, sfVachesEleveur n'affichera que les enregistrements relatifs à l'id éleveur du père :
Certains champs sont cachés : ils sont utiles pour la mise en forme conditionnelle et la navigation, mais les afficher n'aurait aucun intérêt.
Par exemple, pour la mise en forme conditionnelle :
… et pour qu'un double-clic sur le nom du bovidé ouvre le formulaire fVaches à la bonne page :
Option Compare Database
Option Explicit
Private Sub txtNomBovide_DblClick(Cancel As Integer)
DoCmd.OpenForm "fVaches", acNormal, , "tVLPk=" & Me.TXTtVLPk
End SubVII. Le formulaire fRazEleveur▲
VII-A. Présentation▲
Le choix d'un éleveur dans la liste provoque :
- l'élimination de toutes ses vaches et leurs contrôles ;
- le rebaptème des fichiers input xxxx.bak => xxxx.
Ce formulaire est utilisé :
- en cas d'incident survenu lors de l'importation de données : un fichier corrompu, un fichier manquant (rupture de continuité)… Cela permet de recommencer depuis le début après correction de l'anomalie ;
- de purger la base des données obsolètes.
VII-B. Source▲
fRazEleveur est un formulaire indépendant (pas de source).
VII-C. Explication du code associé à fRazEleveur▲
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.
Option Compare Database
Option Explicit
Private Sub cboEleveur_AfterUpdate()
On Error GoTo GestionErreurs
Dim iReponse As Integer
Dim oFSO As Scripting.FileSystemObject
Dim oRep As Scripting.Folder
Dim oFichier As Scripting.File
iReponse = MsgBox("Vous souhaitez éliminer les contrôles de " & vbLf _
& Me.cboEleveur.Column(1) & " ?", vbQuestion + vbDefaultButton2 + vbYesNo)
If iReponse = vbNo Then Exit Sub
'Réinitialiser la DateDerControle
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE tEleveurs SET DateDerControle = #1/1/2000# " _
& "WHERE tEleveursPK=" & Me.cboEleveur & ";"
'Supprimer les enregistrements des tables concernées et dans le bon ordre
'tVelages
DoCmd.RunSQL "DELETE tVelages.tVelagesPK " _
& "FROM tVelages " _
& "WHERE (((tVelages.tVelagesPK) " _
& "In (SELECT tVelages.tVelagesPK " _
& "FROM (tEleveurs INNER JOIN tVL ON tEleveurs.tEleveursPK = tVL.tEleveursFK) " _
& "INNER JOIN tVelages ON tVL.tVLPk = tVelages.tVLFk " _
& "WHERE (((tEleveurs.tEleveursPK)=" & Me.cboEleveur & "));)));"
'tControles
DoCmd.RunSQL "DELETE tControles.tControlesPK " _
& "FROM tControles " _
& "WHERE (((tControles.tControlesPK) " _
& "In (SELECT tControles.tControlesPK " _
& "FROM (tEleveurs INNER JOIN tVL ON tEleveurs.tEleveursPK = tVL.tEleveursFK) " _
& "INNER JOIN tControles ON tVL.tVLPk = tControles.tVLFk " _
& "WHERE (((tEleveurs.tEleveursPK)=" & Me.cboEleveur & "));)));"
'tVL
DoCmd.RunSQL "DELETE tVL.tEleveursFK FROM tVL WHERE tEleveursFK=" & Me.cboEleveur & ";"
DoCmd.SetWarnings True
'Rebaptiser les fichiers .csv.bak => .csv
Set oFSO = New Scripting.FileSystemObject
'Boucle sur les fichiers
'Répertoire SYNel
Set oRep = oFSO.GetFolder(CurrentProject.Path & "\SYNel")
For Each oFichier In oRep.Files
If Mid(oFichier.Name, 10, 6) = Me.cboEleveur.Column(2) Then
oFichier.Name = Replace(oFichier.Name, ".csv.bak", ".csv")
End If
Next oFichier
'Répertoire Agranet
Set oRep = oFSO.GetFolder(CurrentProject.Path & "\Agranet")
For Each oFichier In oRep.Files
If Mid(oFichier.Name, 10, 6) = Me.cboEleveur.Column(2) Then
oFichier.Name = Replace(oFichier.Name, ".xls.bak", ".xls")
End If
Next oFichier
'Répertoire Manuel
Set oRep = oFSO.GetFolder(CurrentProject.Path & "\Manuel")
For Each oFichier In oRep.Files
If Mid(oFichier.Name, 10, 6) = Me.cboEleveur.Column(2) Then
oFichier.Name = Replace(oFichier.Name, ".xls.bak", ".xls")
End If
Next oFichier
Set oRep = Nothing
Set oFSO = Nothing
Exit Sub
GestionErreurs:
Select Case Err.Number
Case 0 ' pas d'erreur
Exit Sub
Case 58 'le fichier .csv (.xls) existe déjà => rebaptisé = original
Resume Next
Case Else
MsgBox "Erreur N° " & Err.Number & " " & Err.Description & vbLf _
& "dans cboEleveur_AfterUpdate()."
End Select
End Sub
17-36 : en raison de l'intégrité référentielle, il faut d'abord supprimer les enregistrements logés dans les tables qui sont le plus bas dans l'arborescence :
VIII. Description du processus d'importation des données▲
En deux clics :
Ce qui déclenche un code qui s'articule comme ceci :
VIII-A. La sous-routine ImportSYNel()▲
Pour importer les données de SYNel, nous avons au préalable défini un modèle, que nous avons appelé « SYNel ».
Pour les détails, voyez Comment créer un modèle d'importation de données externes
VIII-A-1. L'idée générale▲
Dans ImportSYNel, on boucle sur tous les fichiers .csv contenus dans le sous-répertoire et pour chacun d'eux :
- on vérifie sa conformité (appel à la fonction
FichierEstOK()) ; - on importe les données du fichier .csv dans une table intermédiaire (ici tSYNel) et on les transfère dans tImportData, pour poursuivre avec un traitement commun quelle que soit l'origine (SYNel, Agranet…) ;
- on déclenche alors le processus commun
ImportTroncCmmun(), et, si celui-ci s'est déroulé sans erreur, on traite le fichier .csv suivant ; - quand la liste des fichiers à traiter est épuisée, on affiche l'état eJournal pour rendre compte du déroulement du processus de mise à jour.
VIII-A-2. Le code pas à pas▲
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.
Public Sub ImportSYNel()
On Error GoTo GestionErreurs
Dim obFSO As Scripting.FileSystemObject
Dim obRep As Scripting.Folder
Dim obFichier As Scripting.File
Dim sEleveur As String
Dim idEleveur As Long
Dim DateTxt As String
Set obFSO = New Scripting.FileSystemObject
Set obRep = obFSO.GetFolder(CurrentProject.Path & "\SYNel")
'Vidanger tJournal
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tJournal;"
'Boucle sur les fichiers
DoCmd.SetWarnings True
For Each obFichier In obRep.Files
If Right(obFichier.Name, 3) <> "csv" Then GoTo AuSuivant
'Vérifier que le fichier est conforme
If FichierEstOK(obFichier) = False Then GoTo Fin
'Importer
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE tSYNel.* FROM tSYNel;"
DoCmd.TransferText acImportDelim, "SYNel", "tSYNel", obFichier, True
'Transférer les données dans la tImportData
'Vidanger tImportData
DoCmd.RunSQL "DELETE * FROM tImportData;"
'Garnir tImportData
sEleveur = Mid(obFichier.Name, 10, 6)
idEleveur = DLookup("tEleveursPK", "tEleveurs", "NumEleveur='" & sEleveur & "'")
DateTxt = Mid(obFichier.Name, 5, 2) & "/" & Mid(obFichier.Name, 7, 2) & "/" & Left(obFichier.Name, 4)
DoCmd.RunSQL "INSERT INTO tImportData ( DateControle, tEleveursFK, " _
& "NumControle, LAIT, TB, TP, LEUCO, " _
& "NomBovide, Race, NumTrav, NumLacta, DateVelage ) " _
& "SELECT #" & DateTxt & "# AS Expr1," & idEleveur & " AS Expr2, " _
& "tSYNel.NUCONT, tSYNel.LAIT, tSYNel.TB, tSYNel.TP, tSYNel.LEUCO, " _
& "tSYNel.NOBOVI, tSYNel.CORABO, tSYNel.NUTRAV, tSYNel.NULACT, tSYNel.VELAGE " _
& "FROM tSYNel;"
DoCmd.SetWarnings True
'Appeler la partie commune du processus d'importation
If ImportTroncCommun(obFichier) = False Then GoTo Fin
AuSuivant:
Next obFichier
Fin:
If CurrentProject.AllReports("eJournal").IsLoaded Then DoCmd.Close acReport, "eJournal"
DoCmd.OpenReport "eJournal", acViewPreview
GestionErreurs:
Select Case Err.Number
Case 0 ' pas d'erreur
Exit Sub
Case Else
MsgBox "Erreur dans ImportSYNel : " & Err.Number & "-" & Err.Description & ".", vbCritical
End Select
End Sub
Quelques compléments aux commentaires insérés dans le code
3-5 : ces définitions nécessitent d'ajouter la bibliothèque Microsoft Scripting Runtime au projet :
9-10 : on se positionne dans le sous-répertoire SYNel.
13 : on vidange la table tJournal qui servira à consigner le résultat des différentes étapes de cette nouvelle mise à jour.
16 : on déclenche une boucle pour lire chacun des fichiers. La fin de la boucle est en 42.
17 : on n'exécute les instructions que si le fichier en cours de traitement a l'extension « csv ». (Les fichiers déjà importés ont l'extension csv.bak.)
19 : on confie la vérification de la conformité du fichier à la fonction FichierEstOK.
22-23 : on vidange la table tSYNel et on y importe les enregistrements du fichier .csv.
28-30 : pour la requête que nous allons construire aux instructions suivantes, nous devons disposer de la clé de l'éleveur concerné : on utilise la fonction de domaine DLookup.
31-37 : on transfère les colonnes utiles de tSYNel vers tImportData. Le SQL généré à la volée correspond à une requête comme celle-ci :
40 : on passe la main à la fonction ImportTroncCommun(). Si celle-ci se termine normalement, on atteint l'instruction 41 et on reboucle pour traiter le fichier (éventuel) suivant.
44-45 : quand il n'y a plus de fichier à lire dans le répertoire, on affiche l'état eJournal.
À beaucoup d'endroits dans le code, on exécute des requêtes créées à la volée. Si vous voulez les visualiser avec l'interface graphique, copier le SQL dans une requête de test.
Pour vous familiariser avec cette technique voyez ce tutoriel Initiation - Débogage : requêtes écrites par VBA de Charles A (cafeine) et singulièrement, le chapitre V.
Par exemple, pour visualiser la requête qui correspond au SQL généré en 31-37 :
- copiez les instructions 31-37 et remplacez Docmd
.RunSQLpar Debug.Print, pour obtenir ceci :
Debug.Print "INSERT INTO tImportData ( DateControle, tEleveursFK, " _
& "NumControle, LAIT, TB, TP, LEUCO, " _
& "NomBovide, Race, NumTrav, NumLacta, DateVelage ) " _
& "SELECT #" & DateTxt & "# AS Expr1," & idEleveur & " AS Expr2, " _
& "tSYNel.NUCONT, tSYNel.LAIT, tSYNel.TB, tSYNel.TP, tSYNel.LEUCO, " _
& "tSYNel.NOBOVI, tSYNel.CORABO, tSYNel.NUTRAV, tSYNel.NULACT, tSYNel.VELAGE " _
& "FROM tSYNel;"- insérez ce bloc juste après l'instruction 30 ;
- provoquez l'exécution de votre code : placez le curseur dans le code et enfoncez <F5>,
il vient ceci dans la fenêtre d'exécution :
- copiez ce code et collez-le dans le SQL d'une requête de test, le QBE (l'interface graphique) vous montrera ceci :
Ça aide à imaginer ce que le code « brut » voulait dire !
VIII-B. La fonction ImportTroncCommun()▲
VIII-B-1. L'idée générale▲
C'est une fonction, et non une sous-routine (une sous-routine permet d'exécuter du code, mais ne renvoie aucune valeur alors que la fonction exécute le code et renvoie une valeur).
Elle est appelée par ImportSYNel pour chaque fichier importé et elle lui renverra « True » si elle s'est déroulée sans accroc.
Sa tâche est de récupérer les données importées par ImportSYNel et de les intégrer dans les différentes tables du modèle. Elle sous-traitera une partie des calculs à une autre fonction : Cumuls().
VIII-B-2. Le code pas à pas▲
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.
Public Function ImportTroncCommun(obFichier As Scripting.File) As Boolean
On Error GoTo GestionErreurs
Dim idEleveur As Long
Dim sEleveur As String
Dim DateTxt As String
ImportTroncCommun = True
DoCmd.SetWarnings False
'Supprimer les enregistrements blancs éventuels
DoCmd.RunSQL "DELETE tImportData.NumControle FROM tImportData WHERE tImportData.NumControle Is Null;"
'Remplacer le Nom de bovidé manquant par le N° travail
DoCmd.RunSQL "UPDATE tImportData SET tImportData.NomBovide = [NumTrav] WHERE tImportData.NomBovide Is Null;"
'Concaténer le nom de la vache et son N° de travail pour éviter les homonymes
DoCmd.RunSQL "UPDATE tImportData SET tImportData.NomBovide = [NomBovide] & "" - "" & [NumTrav];"
'Garnir la table tVL
sEleveur = Mid(obFichier.Name, 10, 6)
idEleveur = DLookup("tEleveursPK", "tEleveurs", "NumEleveur='" & sEleveur & "'")
DoCmd.RunSQL "INSERT INTO tVL ( tEleveursFK,NomBovide,RACE,NumTrav ) " _
& "SELECT " & idEleveur & " AS idElev, tImportData.NomBovide, tImportData.Race, tImportData.NumTrav " _
& "FROM tImportData;"
'Garnir la colonne tVLFK
DoCmd.RunSQL "UPDATE tImportData INNER JOIN tVL " _
& "ON (tImportData.NomBovide = tVL.NomBovide) " _
& " AND (tImportData.tEleveursFK = tVL.tEleveursFK) " _
& " SET tImportData.tVLFk = [tVLPk];"
DoCmd.SetWarnings True
'Appeler Cumuls()
If Cumuls(obFichier) = False Then
ImportTroncCommun = False
Exit Function
End If
'Mettre à jour Lait 7 %
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE tImportData SET tImportData.Lait7pc = ([MoyTB]+[MoyTP])*[CumulLait]/70;"
'Mettre à jour NumLacta
DoCmd.RunSQL "UPDATE tImportData INNER JOIN tVL ON tImportData.tVLFk = tVL.tVLPk SET tVL.NumLacta = [tImportData].[NumLacta];"
'Garnir tControles
DoCmd.RunSQL "INSERT INTO tControles ( tVLFk, DateControle, NumControle, " _
& " LAIT, TB, TP, LEUCO, DureeLacta, CumulLait, MoyTB, MoyTP,Lait7pc ) " _
& "SELECT tImportData.tVLFk, tImportData.DateControle, " _
& "tImportData.NumControle, tImportData.LAIT, tImportData.TB, " _
& "tImportData.TP, tImportData.LEUCO, tImportData.DureeLacta, " _
& "tImportData.CumulLait, tImportData.MoyTB, tImportData.MoyTP,tImportData.Lait7pc " _
& "FROM tImportData;"
'Garnir tVelages
DoCmd.RunSQL "INSERT INTO tVelages ( tVLFk, DateVelage ) " _
& "SELECT tImportData.tVLFk, tImportData.DateVelage " _
& "FROM tImportData;"
'Mettre à jour DateDerControle
DateTxt = Mid(obFichier.Name, 5, 2) & "/" & Mid(obFichier.Name, 7, 2) & "/" & Left(obFichier.Name, 4)
DoCmd.RunSQL "UPDATE tEleveurs SET tEleveurs.DateDerControle =#" & DateTxt & "#" _
& " WHERE NumEleveur=""" & sEleveur & """;"
DoCmd.SetWarnings True
'Renommer le fichier original
obFichier.Name = obFichier.Name & ".bak"
'Journaliser le bon déroulement du traitement de ce fichier
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tJournal ( Fichier, Quand, Evenement,NivGrave ) " _
& "SELECT """ & obFichier.Name & """ AS Expr1, Now() AS Expr2, " _
& """Traitement OK."" AS Expr3, 0 as Expr4;"
DoCmd.SetWarnings True
GestionErreurs:
Select Case Err.Number
Case 0 ' pas d'erreur
Exit Function
Case Else
MsgBox "Erreur dans ImportTroncCommun : " & Err.Number & "-" & Err.Description & ".", vbCritical
End Select
End Function
Quelques compléments aux commentaires insérés dans le code
15-19 : cette requête provoquera l'ajout des éventuelles nouvelles vaches dans la table tVL. Les doublons seront rejetés :
27-29 : si le calcul des cumuls s'est mal déroulé (on verra au § suivant que Cumuls() l'a signalé par un message), ImportTroncCommun() s'arrête en renvoyant « False » à SYNel() qui l'avait appelée… et le processus d'import s'interrompt.
VIII-C. La fonction Cumuls()▲
VIII-C-1. L'idée générale▲
On lit un à un les enregistrements de tImportdata.
On calcule ici les différents cumuls des données ponctuelles recueillies lors du contrôle. Ces calculs diffèrent selon le N° du contrôle.
On écrit le résultat des calculs dans les colonnes ad hoc de tImportData.
VIII-C-2. Le code pas à pas▲
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.
Public Function Cumuls(obFichier As Scripting.File) As Boolean
On Error GoTo GestionErreurs
Dim lReponse As Long
Dim rst As Recordset
Dim NbreJrsCtlPrec As Integer
Dim sSql As String
Cumuls = True
'Lire les enregistrements de tImportData et compléter les colonnes de cumuls
Set rst = CurrentDb.OpenRecordset("tImportData")
NbreJrsCtlPrec = rst("DateControle") _
- Nz(DLookup("DateControle", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")), rst("DateControle"))
Do Until rst.EOF
rst.Edit
'Durée Lactation
'Date de contrôle - date vêlage
rst("DureeLacta") = rst("DateControle") - rst("DateVelage")
'Si N°Ctl = 0, ne rien faire d'autre
If rst("NumControle") = 0 Then GoTo MaJEtSuivant
If rst("NumControle") = 1 Then
'Traitement lors du 1er contrôle
'-------------------------------
'cumul lait = Lait du contrôle multiplié par la durée de lactation
rst("CumulLait") = rst("Lait") * rst("DureeLacta")
'Moyenne TB =
rst("MoyTB") = rst("TB")
rst("MoyTP") = rst("TP")
ElseIf IsNull(DLookup("tVLFk", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))) Then
'Traitement pour les vaches qui apparaissent la 1re fois avec un N°>1
'--------------------------------------------------------------------
rst("CumulLait") = Null
'Moyenne TB =
rst("MoyTB") = Null
rst("MoyTP") = Null
Else
'Traitement en régime de croisière
'---------------------------------
'Vérifier que les contrôles se suivent
If rst("NumControle") - DLookup("NumControle", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")) <> 1 Then
lReponse = MsgBox("Processus stoppé, car l'ordre des contrôles n'est pas respecté " & vbLf _
& "pour la VL " & rst("NomBovide") & vbLf _
& "dans le fichier " & obFichier.Name & "." & vbLf _
& "Voulez-vous continuer (sans les cumuls pour cette vache) ?", _
vbQuestion + vbYesNo + vbDefaultButton1)
If lReponse = vbNo Then
'Journaliser le refus de continuer
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tJournal ( Fichier, Quand, Evenement,NivGrave ) " _
& "SELECT """ & obFichier.Name & """ AS Expr1, Now() AS Expr2, " _
& """Manque de continuité dans les N° des contrôles de la vache " _
& rst("NomBovide") & ". Avec arrêt."" AS Expr3, 2 as Expr4;"
DoCmd.SetWarnings True
Cumuls = False
Exit Function
Else
'Journaliser l'anomalie et décision de continuer
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tJournal ( Fichier, Quand, Evenement,NivGrave ) " _
& "SELECT """ & obFichier.Name & """ AS Expr1, Now() AS Expr2, " _
& """Manque de continuité dans les N° des contrôles de la vache " _
& rst("NomBovide") & ". Avec poursuite."" AS Expr3, 1 as expr4;"
DoCmd.SetWarnings True
rst("CumulLait") = Null
rst("MoyTB") = Null
rst("MoyTP") = Null
GoTo MaJEtSuivant
End If
End If
'Nouveau lait produit = Moyenne entre lait(C) et lait(C-1)
'Cumul lait = NouveauLait + Cumul(C-1)
rst("CumulLait") = (rst("Lait") + DLookup("Lait", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))) / 2 * NbreJrsCtlPrec _
+ DLookup("CumulLait", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))
'Moyenne TB = MoyTB(C-1)*CumulLait(C-1)
' + Nouveau lait multiplié par la moyenne entre TB(C) et TB(C-1)
' le tout divisé par CumulLait(C)
rst("MoyTB") = (DLookup("MoyTB", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")) _
* DLookup("CumulLait", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")) _
+ (rst("TB") + DLookup("TB", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))) / 2 _
* NbreJrsCtlPrec * rst("Lait")) / rst("CumulLait")
'Moyenne TP = MoyTP(C-1)*CumulLait(C-1) + Nouveau Lait * Moyenne entre TP(C) et TP(C-1)
' le tout divisé par CumulLait(C)
rst("MoyTP") = (DLookup("MoyTP", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")) _
* DLookup("CumulLait", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")) _
+ (rst("TP") + DLookup("TP", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))) / 2 _
* NbreJrsCtlPrec * rst("Lait")) / rst("CumulLait")
End If
MaJEtSuivant:
rst.Update
rst.MoveNext
Loop
'Libérer la mémoire et sortir
rst.Close
Set rst = Nothing
GestionErreurs:
Select Case Err.Number
Case 0 ' pas d'erreur
Exit Function
Case Else
MsgBox "Erreur dans Cumuls : " & Err.Number & "-" & Err.Description & ".", vbCritical
End Select
End Function
10 : à ce stade du processus, il faut bien avoir à l'esprit que tImportData, le recordset que nous sommes en train de lire, contient les données du nouveau contrôle. Pour calculer les cumuls, nous devons aussi disposer des données du contrôle précédent, c'est-à-dire le dernier qui a été enregistré dans la db.
Pour faciliter l'accès au dernier contrôle enregistré pour chaque vache, voici comment on s'y est pris :
- 1er temps, une requête pour identifier le dernier contrôle de chaque vache :
- 2e temps, sur base de cette rDernCtlVL et tControles, cette autre requête :
À l'instruction 11, on utilise la fonction de domaine dLoopUp pour chercher la date du dernier contrôle de la vache en cours de traitement.
Si le contrôle est le premier pour cette vache… il n'y a pas de précédent et
DLookup("DateControle", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))
retournera Null.
Pour rencontrer ce cas particulier, nous utilisons la fonction Nz()
Elle vaut :
- l'argument1, si celui-ci n'est pas Null ;
- sinon l'argument2.
Dans notre cas :
Et NbreJrsCtPrec vaudra le nombre de jours écoulés
- depuis le précédent contrôle (s'il en est)
ou
- zéro (s'il n'en est pas).
12 : on lance la boucle pour lire un à un les enregistrements de tImportData pour compléter les colonnes des cumuls. Fin de la boucle en 93.
18-89 : les calculs diffèrent selon le N° du contrôle.
Deux cas particuliers
- 29-35 : cas particulier d'une vache dont le 1er contrôle n'est pas numéroté « 1 » (nouveau client : on ne dispose pas de l'historique) : on attribue la valeur Null aux colonnes. Pour cette vache, les cumuls resteront à Null jusqu'à son prochain vêlage.
- 41-46 : si on constate un hiatus dans la numérotation des contrôles (le N° présenté n'est pas celui qui suit le dernier enregistré), on émet un message
Si la réponse est non, 48-57, on journalise l'incident, on attribue valeur False à la fonction Cumuls et on sort, ce qui aura pour effet de stopper le processus d'importation pour la totalité des enregistrements du fichier en cours de lecture et les suivants éventuels.
Si la réponse est Oui, 58-69, on fait l'impasse sur cette anomalie (mais on la journalise 61-64), les cumuls ne sont pas calculés pour cette vache et on passe à l'enregistrement suivant.
À charge de l'utilisateur d'examiner le cas et à prendre les dispositions qui s'imposent. Comme les cumuls ont été mis à Null, plus aucun cumul ne pourra être calculé pour cette vache jusqu'à son prochain vêlage. (C'est-à-dire quand un contrôle N° 1 reviendra pour cette vache.)
Cas ordinaires
- 18 : si le N° de contrôle = 0, on ne calcule rien (la vache est en fin de gestation).
- 20-27 : si le N° de contrôle = 1, pour estimer les cumuls, on considère que la production du jour du contrôle est celle qui a prévalu depuis le dernier vêlage.
- 72-88 : pour les autres contrôles, on considère que la production journalière depuis le contrôle précédent est la moyenne entre ce précédent et le nouveau.
VIII-D. La fonction FichierEstOK()▲
VIII-D-1. L'idée générale▲
S'il s'agit d'un fichier .csv, on vérifie si sa première ligne contient effectivement les noms de colonnes. (Ceci permet d'écarter un fichier corrompu lors du téléchargement.)
Pour tout fichier, on vérifie que la date indiquée dans son nom est effectivement plus récente que celle de la dernière mise à jour pour cet éleveur.
VIII-D-2. Le code pas à pas▲
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 Function FichierEstOK(obFichier As Scripting.File) As Boolean
On Error GoTo GestionErreurs
Dim obTS As TextStream
Dim sLigne1 As String
Dim DateTxt As String
Dim DateFichier As Date
Dim sEleveur As String
FichierEstOK = True
'Vérifier la structure des fichiers csv
'--------------------------------------
If Right(obFichier.Name, 3) = "csv" Then
Set obTS = obFichier.OpenAsTextStream(ForReading)
sLigne1 = obTS.ReadLine
If sLigne1 <> "COPAIP;NUNATI;CORABO;NOBOVI;NUTRAV;NULACT;NUCONT;LAIT;BAISSE;TB;TP;BILEUC;LEUCO;VELAGE;DULACT;CULAIT;MYTBLA;MYTPLA;CULAST" Then
'Si le contenu n'a pas la structure conforme, journaliser et provoquer l'arrêt
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tJournal ( Fichier, Quand, Evenement ) " _
& "SELECT """ & obFichier.Name & """ AS Expr1, Now() AS Expr2, " _
& """Structure non conforme"" AS Expr3;"
DoCmd.SetWarnings True
FichierEstOK = False
End If
'Libérer
Set obTS = Nothing
End If
'Vérifier le bon ordre chronologique
'-----------------------------------
DateFichier = DateSerial(Left(obFichier.Name, 4), Mid(obFichier.Name, 5, 2), Mid(obFichier.Name, 7, 2))
DateTxt = Mid(obFichier.Name, 5, 2) & "/" & Mid(obFichier.Name, 7, 2) & "/" & Left(obFichier.Name, 4)
sEleveur = Mid(obFichier.Name, 10, 6)
'Vérifier que la date du fichier est postérieure
'au dernier contrôle enregistré pour cet éleveur
If DateFichier <= DLookup("DateDerControle", "tEleveurs", "NumEleveur='" & sEleveur & "'") Then
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tJournal ( Fichier, Quand, Evenement ) " _
& "SELECT """ & obFichier.Name & """ AS Expr1, Now() AS Expr2, " _
& """La date du fichier n'est pas postérieure à celle de la précédente MàJ"" AS Expr3;"
DoCmd.SetWarnings True
FichierEstOK = False
End If
GestionErreurs:
Select Case Err.Number
Case 0 ' pas d'erreur
Exit Function
Case Else
MsgBox "Erreur dans FichierEstOK : " & Err.Number & "-" & Err.Description & ".", vbCritical
End Select
End Function
Quelques compléments aux commentaires insérés dans le code
3 : la définition de cette variable implique que la bibliothèque Microsoft DAO x.x Object Libary soit ajoutée au projet.
17-19 et 35-37 : si on constate une anomalie, on la journalise et on renvoie False qui provoquera l'arrêt du processus de mise à jour pour ce fichier et les suivants éventuels.
VIII-E. L'état eJournal▲
C'est simplement la liste du contenu de la table tJournal avec une mise en forme conditionnelle du champ Evenement :
IX. Annexes▲
IX-A. Comment créer un modèle d'importation de données externes▲
Nous avons défini une table pour recueillir les données :
Dans la barre des menus : Fichier>Données externes>Importer
S'ouvre alors une fenêtre qui permet de désigner le fichier.
On en choisit un (ils ont tous la même structure).
Il vient :
Clic sur Suivant > :
Clic sur Suivant > :
Clic sur Avancé… :
Clic sur Enregistrer sous… :
Clic sur OK, refermez la fenêtre :
et un dernier clic sur Terminer :
X. À suivre…▲
Nous venons d'examiner comment les données externes sont importées dans la base de données.
Dans un deuxième article nous verrons comment exploiter ces données pour contrôler l'évolution de la production laitière d'un troupeau, notamment avec ce formulaire :
À bientôt !
XI. Téléchargement▲
La base de données au format Access 2000 est ici.
(Décompressez l'archive dans un répertoire quelconque.)
XII. Remerciements▲
Ma gratitude à Joël50 qui a pris le temps de m'expliquer en détail les aspects métier de ce tutoriel.
Merci à Pierre Fauconnier et à User pour leur aide technique et à f-leb pour la correction orthographique.