Developpez.com

Télécharger gratuitement le magazine des développeurs, le bimestriel des développeurs avec une sélection des meilleurs tutoriels

Contrôler la production de vaches laitières avec Access

Première partie : capter et stocker les données

En relation avec cette question posée sur le forum.

Si vous consultez cet article en tant que tutoriel, vous y trouverez des exemples :

- d'importation de fichiers plats (xls, csv…) pour les intégrer dans les tables d'un modèle de données Access ;

- de mise en forme conditionnelle d'un groupe d'options ;

- de formulaires père/fils avec recherche multicritère.

Pour vos réactions, un espace est ouvert 4 commentaires Donner une note à l'article (5) 

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

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 :

Image non disponible

Pour récupérer les données, SYNel propose le téléchargement d'un fichier .csv :

Image non disponible

Pour Agranet, on copie-colle dans un fichier Excel :

Image non disponible

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.

Image non disponible

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

Image non disponible

« Manuel », pour les quelques rares éleveurs qui communiquent les résultats en encodant une feuille Excel.

IV. Le modèle de données

Image non disponible

Image non disponible et Image non disponible 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.

Image non disponible 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.

Image non disponible 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

Image non disponible

V-B. Sa source

Image non disponible

V-C. fVaches a deux sous-formulaires fils : sfControles et sfVelages

Image non disponible

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

 
Sélectionnez
1.
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 :

Image non disponible

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 :

Image non disponible

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 :

Image non disponible

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

Image non disponible

VI-B. Sa source

Image non disponible

VI-C. Explication du code associé à fEleveurs

 
Sélectionnez
1.
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 :

Image non disponible

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 :

Image non disponible

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.

Image non disponible

Par exemple, pour la mise en forme conditionnelle :

Image non disponible

… et pour qu'un double-clic sur le nom du bovidé ouvre le formulaire fVaches à la bonne page :

 
Sélectionnez
Option Compare Database
Option Explicit

Private Sub txtNomBovide_DblClick(Cancel As Integer)
  DoCmd.OpenForm "fVaches", acNormal, , "tVLPk=" & Me.TXTtVLPk
End Sub

VII. Le formulaire fRazEleveur

VII-A. Présentation

Image non disponible

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

 
Sélectionnez
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.
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  " & 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 :

Image non disponible

VIII. Description du processus d'importation des données

En deux clics :

Image non disponible

Ce qui déclenche un code qui s'articule comme ceci :

Image non disponible

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

 
Sélectionnez
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.
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 :

Image non disponible

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 :

Image non disponible

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.RunSQL par Debug.Print, pour obtenir ceci :
 
Sélectionnez
          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 :

Image non disponible
  • copiez ce code et collez-le dans le SQL d'une requête de test, le QBE (l'interface graphique) vous montrera ceci :
Image non disponible

Ç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

 
Sélectionnez
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.
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  travail
  DoCmd.RunSQL "UPDATE tImportData SET tImportData.NomBovide = [NumTrav] WHERE tImportData.NomBovide Is Null;"
  'Concaténer le nom de la vache et son  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 :

Image non disponible

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

 
Sélectionnez
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.
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  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  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 :
Image non disponible
  • 2e temps, sur base de cette rDernCtlVL et tControles, cette autre requête :
Image non disponible

À 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.

Image non disponible

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()

Image non disponible

Elle vaut :

- l'argument1, si celui-ci n'est pas Null ;

- sinon l'argument2.

Dans notre cas :

Image non disponible

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
Image non disponible

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

 
Sélectionnez
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.
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.

Image non disponible

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

Image non disponible

C'est simplement la liste du contenu de la table tJournal avec une mise en forme conditionnelle du champ Evenement :

Image non disponible

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 :

Image non disponible

Dans la barre des menus : Fichier>Données externes>Importer

Image non disponible

S'ouvre alors une fenêtre qui permet de désigner le fichier.

Image non disponible

On en choisit un (ils ont tous la même structure).

Il vient :

Image non disponible

Clic sur Suivant > :

Image non disponible

Clic sur Suivant > :

Image non disponible

Clic sur Avancé… :

Image non disponible

Clic sur Enregistrer sous… :

Image non disponible

Clic sur OK, refermez la fenêtre :

Image non disponible

et un dernier clic sur Terminer :

Image non disponible

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 :

Image non disponible

À bientôt !

Cette deuxième partie est ici.

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.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2015 Claude Leloup. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.