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

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

Claude Leloup

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 Commentez

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

- Auteur : Claude Leloup

- Parution : 16 juin 2015

- Licence : 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.

Sommaire

- I. Prérequis

- II. Contexte de l'application

- II-A. Objectif

- II-B. Origine des données

- II-C. Quelles sont les données utiles ?

- II-C-1. Les coordonnées de l'éleveur

- II-C-2. L'identité de la vache

- II-C-3. L'historique des contrôles de la vache

- III. L'arborescence des fichiers

- IV. Le modèle de données

- V. Le formulaire fVaches

- V-A. Présentation

- V-B. Sa source

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

- V-D. Explication du code associé à fVaches

- VI. Le formulaire fEleveurs

- VI-A. Présentation

- VI-B. Sa source

- VI-C. Explication du code associé à fEleveurs

- VI-D. Le sous-formulaire fils sfVachesEleveur

- VII. Le formulaire fRazEleveur

- VII-A. Présentation

- VII-B. Source

- VII-C. Explication du code associé à fRazEleveur

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

- VIII-A. La sous-routine ImportSYNel()

- VIII-A-1. L'idée générale

- VIII-A-2. Le code pas à pas

- VIII-B. La fonction ImportTroncCommun()

- VIII-B-1. L'idée générale

- VIII-B-2. Le code pas à pas

- VIII-C. La fonction Cumuls()

- VIII-C-1. L'idée générale

- VIII-C-2. Le code pas à pas

- VIII-D. La fonction FichierEstOK()

- VIII-D-1. L'idée générale

- VIII-D-2. Le code pas à pas

- VIII-E. L'état eJournal

- IX. Annexes

- IX-A. Comment créer un modèle d'importation de données externes

- X. À suivre…

- XI. Téléchargement

- XII. Remerciements

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

1. Option Compare Database

2. Option Explicit

4. Private Sub Form_Current()

5. 'Gérer la couleur du contrôle caPresenceDerCtl

6. Me.caPresenceDerCtl = DCount("*", "rVLPresenteDernCtl")

7. If Me.caPresenceDerCtl = 1 Then 'Vache présente

8. Me.caPresenceDerCtl.BackColor = 52377  'vert

9. Else

10. Me.caPresenceDerCtl.BackColor = 52479  'orange

11. End If

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

1. Option Compare Database

2. Option Explicit

4. Private Sub cboEleveur_AfterUpdate()

5. 'On cherche l'enregistrement qui contient cette valeur

6. Me.Recordset.FindFirst "tEleveursPK =" & Me.cboEleveur

7. End Sub

9. Private Sub Form_Current()

10. 'Aménager le texte variable

11. 'S'il s'agit de l'encodage d'un nouveau, on n'exécute pas ce code

12. If Me.NewRecord Then Exit Sub

13. 'Pour les autres enregistrements, on construit le texte qui dénombre les vaches

14. Me.txtTroupeau = ": " _

15. & DCount("Presente", "rToutesVL", "Presente=-1 and tEleveursFK =" & Me.TXTtEleveursPK) _

16. & " actuellement, dont " _

17. & DCount("Nouvelle", "rToutesVL", "Nouvelle=-1 and tEleveursFK =" & Me.TXTtEleveursPK) _

18. & " nouvelle(s)"

19. 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 Sub

VII - 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

1. Option Compare Database

2. Option Explicit

3. Private Sub cboEleveur_AfterUpdate()

4. On Error GoTo GestionErreurs

5. Dim iReponse As Integer

6. Dim oFSO As Scripting.FileSystemObject

7. Dim oRep As Scripting.Folder

8. Dim oFichier As Scripting.File

9. iReponse = MsgBox("Vous souhaitez éliminer les contrôles de " & vbLf _

10. & Me.cboEleveur.Column(1) & " ?", vbQuestion + vbDefaultButton2 + vbYesNo)

11. If iReponse = vbNo Then Exit Sub

12. 'Réinitialiser la DateDerControle

13. DoCmd.SetWarnings False

14. DoCmd.RunSQL "UPDATE tEleveurs SET DateDerControle = #1/1/2000# " _

15. & "WHERE tEleveursPK=" & Me.cboEleveur & ";"

16. 'Supprimer les enregistrements des tables concernées et dans le bon ordre

17. 'tVelages

18. DoCmd.RunSQL "DELETE tVelages.tVelagesPK " _

19. & "FROM tVelages " _

20. & "WHERE (((tVelages.tVelagesPK) " _

21. & "In (SELECT tVelages.tVelagesPK " _

22. & "FROM (tEleveurs INNER JOIN tVL ON tEleveurs.tEleveursPK = tVL.tEleveursFK) " _

23. & "INNER JOIN tVelages ON tVL.tVLPk = tVelages.tVLFk " _

24. & "WHERE (((tEleveurs.tEleveursPK)=" & Me.cboEleveur & "));)));"

25. 'tControles

26. DoCmd.RunSQL "DELETE tControles.tControlesPK " _

27. & "FROM tControles " _

28. & "WHERE (((tControles.tControlesPK) " _

29. & "In (SELECT tControles.tControlesPK " _

30. & "FROM (tEleveurs INNER JOIN tVL ON tEleveurs.tEleveursPK = tVL.tEleveursFK) " _

31. & "INNER JOIN tControles ON tVL.tVLPk = tControles.tVLFk " _

32. & "WHERE (((tEleveurs.tEleveursPK)=" & Me.cboEleveur & "));)));"

33. 'tVL

34. DoCmd.RunSQL "DELETE tVL.tEleveursFK  FROM tVL WHERE tEleveursFK=" & Me.cboEleveur & ";"

35. DoCmd.SetWarnings True

36. 'Rebaptiser les fichiers .csv.bak => .csv

37. Set oFSO = New Scripting.FileSystemObject

38. 'Boucle sur les fichiers

39. 'Répertoire SYNel

40. Set oRep = oFSO.GetFolder(CurrentProject.Path & "\SYNel")

41. For Each oFichier In oRep.Files

42. If Mid(oFichier.Name, 10, 6) = Me.cboEleveur.Column(2) Then

43. oFichier.Name = Replace(oFichier.Name, ".csv.bak", ".csv")

44. End If

45. Next oFichier

46. 'Répertoire Agranet

47. Set oRep = oFSO.GetFolder(CurrentProject.Path & "\Agranet")

48. For Each oFichier In oRep.Files

49. If Mid(oFichier.Name, 10, 6) = Me.cboEleveur.Column(2) Then

50. oFichier.Name = Replace(oFichier.Name, ".xls.bak", ".xls")

51. End If

52. Next oFichier

53. 'Répertoire Manuel

54. Set oRep = oFSO.GetFolder(CurrentProject.Path & "\Manuel")

55. For Each oFichier In oRep.Files

56. If Mid(oFichier.Name, 10, 6) = Me.cboEleveur.Column(2) Then

57. oFichier.Name = Replace(oFichier.Name, ".xls.bak", ".xls")

58. End If

59. Next oFichier

60. Set oRep = Nothing

61. Set oFSO = Nothing

62. Exit Sub

63. GestionErreurs:

64. Select Case Err.Number

65. Case 0 ' pas d'erreur

66. Exit Sub

67. Case 58 'le fichier .csv (.xls) existe déjà => rebaptisé = original

68. Resume Next

69. Case Else

70. MsgBox "Erreur N° " & Err.Number & " " & Err.Description & vbLf _

71. & "dans cboEleveur_AfterUpdate()."

72. End Select

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

1. Public Sub ImportSYNel()

2. On Error GoTo GestionErreurs

3. Dim obFSO As Scripting.FileSystemObject

4. Dim obRep As Scripting.Folder

5. Dim obFichier As Scripting.File

6. Dim sEleveur As String

7. Dim idEleveur As Long

8. Dim DateTxt As String

9. Set obFSO = New Scripting.FileSystemObject

10. Set obRep = obFSO.GetFolder(CurrentProject.Path & "\SYNel")

11. 'Vidanger tJournal

12. DoCmd.SetWarnings False

13. DoCmd.RunSQL "DELETE *  FROM tJournal;"

14. 'Boucle sur les fichiers

15. DoCmd.SetWarnings True

16. For Each obFichier In obRep.Files

17. If Right(obFichier.Name, 3) <> "csv" Then GoTo AuSuivant

18. 'Vérifier que le fichier est conforme

19. If FichierEstOK(obFichier) = False Then GoTo Fin

20. 'Importer

21. DoCmd.SetWarnings False

22. DoCmd.RunSQL "DELETE tSYNel.* FROM tSYNel;"

23. DoCmd.TransferText acImportDelim, "SYNel", "tSYNel", obFichier, True

24. 'Transférer les données dans la tImportData

25. 'Vidanger tImportData

26. DoCmd.RunSQL "DELETE * FROM tImportData;"

27. 'Garnir tImportData

28. sEleveur = Mid(obFichier.Name, 10, 6)

29. idEleveur = DLookup("tEleveursPK", "tEleveurs", "NumEleveur='" & sEleveur & "'")

30. DateTxt = Mid(obFichier.Name, 5, 2) & "/" & Mid(obFichier.Name, 7, 2) & "/" & Left(obFichier.Name, 4)

31. DoCmd.RunSQL "INSERT INTO tImportData ( DateControle, tEleveursFK, " _

32. & "NumControle, LAIT, TB, TP, LEUCO, " _

33. & "NomBovide, Race, NumTrav, NumLacta, DateVelage ) " _

34. & "SELECT #" & DateTxt & "# AS Expr1," & idEleveur & " AS Expr2, " _

35. & "tSYNel.NUCONT, tSYNel.LAIT, tSYNel.TB, tSYNel.TP, tSYNel.LEUCO, " _

36. & "tSYNel.NOBOVI, tSYNel.CORABO, tSYNel.NUTRAV, tSYNel.NULACT, tSYNel.VELAGE " _

37. & "FROM tSYNel;"

38. DoCmd.SetWarnings True

39. 'Appeler la partie commune du processus d'importation

40. If ImportTroncCommun(obFichier) = False Then GoTo Fin

41. AuSuivant:

42. Next obFichier

43. Fin:

44. If CurrentProject.AllReports("eJournal").IsLoaded Then DoCmd.Close acReport, "eJournal"

45. DoCmd.OpenReport "eJournal", acViewPreview

46. GestionErreurs:

47. Select Case Err.Number

48. Case 0 ' pas d'erreur

49. Exit Sub

50. Case Else

51. MsgBox "Erreur dans ImportSYNel : " & Err.Number & "-" & Err.Description & ".", vbCritical

52. End Select

53. 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.RunSQL par 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

1. Public Function ImportTroncCommun(obFichier As Scripting.File) As Boolean

2. On Error GoTo GestionErreurs

3. Dim idEleveur As Long

4. Dim sEleveur As String

5. Dim DateTxt As String

6. ImportTroncCommun = True

7. DoCmd.SetWarnings False

8. 'Supprimer les enregistrements blancs éventuels

9. DoCmd.RunSQL "DELETE tImportData.NumControle FROM tImportData WHERE tImportData.NumControle Is Null;"

10. 'Remplacer le Nom de bovidé manquant par le N° travail

11. DoCmd.RunSQL "UPDATE tImportData SET tImportData.NomBovide = [NumTrav] WHERE tImportData.NomBovide Is Null;"

12. 'Concaténer le nom de la vache et son N° de travail pour éviter les homonymes

13. DoCmd.RunSQL "UPDATE tImportData SET tImportData.NomBovide = [NomBovide] & "" - "" & [NumTrav];"

14. 'Garnir la table tVL

15. sEleveur = Mid(obFichier.Name, 10, 6)

16. idEleveur = DLookup("tEleveursPK", "tEleveurs", "NumEleveur='" & sEleveur & "'")

17. DoCmd.RunSQL "INSERT INTO tVL ( tEleveursFK,NomBovide,RACE,NumTrav ) " _

18. & "SELECT " & idEleveur & " AS idElev, tImportData.NomBovide, tImportData.Race, tImportData.NumTrav " _

19. & "FROM tImportData;"

20. 'Garnir la colonne tVLFK

21. DoCmd.RunSQL "UPDATE tImportData INNER JOIN tVL " _

22. & "ON (tImportData.NomBovide = tVL.NomBovide) " _

23. & " AND (tImportData.tEleveursFK = tVL.tEleveursFK) " _

24. & " SET tImportData.tVLFk = [tVLPk];"

25. DoCmd.SetWarnings True

26. 'Appeler Cumuls()

27. If Cumuls(obFichier) = False Then

28. ImportTroncCommun = False

29. Exit Function

30. End If

31. 'Mettre à jour Lait 7 %

32. DoCmd.SetWarnings False

33. DoCmd.RunSQL "UPDATE tImportData SET tImportData.Lait7pc = ([MoyTB]+[MoyTP])*[CumulLait]/70;"

34. 'Mettre à jour NumLacta

35. DoCmd.RunSQL "UPDATE tImportData INNER JOIN tVL ON tImportData.tVLFk = tVL.tVLPk SET tVL.NumLacta = [tImportData].[NumLacta];"

36. 'Garnir tControles

37. DoCmd.RunSQL "INSERT INTO tControles ( tVLFk, DateControle, NumControle, " _

38. & " LAIT, TB, TP, LEUCO, DureeLacta, CumulLait, MoyTB, MoyTP,Lait7pc ) " _

39. & "SELECT tImportData.tVLFk, tImportData.DateControle, " _

40. & "tImportData.NumControle, tImportData.LAIT, tImportData.TB, " _

41. & "tImportData.TP, tImportData.LEUCO, tImportData.DureeLacta, " _

42. & "tImportData.CumulLait, tImportData.MoyTB, tImportData.MoyTP,tImportData.Lait7pc " _

43. & "FROM tImportData;"

44. 'Garnir tVelages

45. DoCmd.RunSQL "INSERT INTO tVelages ( tVLFk, DateVelage ) " _

46. & "SELECT tImportData.tVLFk, tImportData.DateVelage " _

47. & "FROM tImportData;"

48. 'Mettre à jour DateDerControle

49. DateTxt = Mid(obFichier.Name, 5, 2) & "/" & Mid(obFichier.Name, 7, 2) & "/" & Left(obFichier.Name, 4)

51. DoCmd.RunSQL "UPDATE tEleveurs SET tEleveurs.DateDerControle =#" & DateTxt & "#" _

52. & " WHERE NumEleveur=""" & sEleveur & """;"

53. DoCmd.SetWarnings True

54. 'Renommer le fichier original

55. obFichier.Name = obFichier.Name & ".bak"

56. 'Journaliser le bon déroulement du traitement de ce fichier

57. DoCmd.SetWarnings False

58. DoCmd.RunSQL "INSERT INTO tJournal ( Fichier, Quand, Evenement,NivGrave ) " _

59. & "SELECT """ & obFichier.Name & """ AS Expr1, Now() AS Expr2, " _

60. & """Traitement OK."" AS Expr3, 0 as Expr4;"

61. DoCmd.SetWarnings True

62. GestionErreurs:

63. Select Case Err.Number

64. Case 0 ' pas d'erreur

65. Exit Function

66. Case Else

67. MsgBox "Erreur dans ImportTroncCommun : " & Err.Number & "-" & Err.Description & ".", vbCritical

68. End Select

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

1. Public Function Cumuls(obFichier As Scripting.File) As Boolean

2. On Error GoTo GestionErreurs

3. Dim lReponse As Long

4. Dim rst As Recordset

5. Dim NbreJrsCtlPrec As Integer

6. Dim sSql As String

7. Cumuls = True

8. 'Lire les enregistrements de tImportData et compléter les colonnes de cumuls

9. Set rst = CurrentDb.OpenRecordset("tImportData")

10. NbreJrsCtlPrec = rst("DateControle") _

11. - Nz(DLookup("DateControle", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")), rst("DateControle"))

12. Do Until rst.EOF

13. rst.Edit

14. 'Durée Lactation

15. 'Date de contrôle - date vêlage

16. rst("DureeLacta") = rst("DateControle") - rst("DateVelage")

17. 'Si N°Ctl = 0, ne rien faire d'autre

18. If rst("NumControle") = 0 Then GoTo MaJEtSuivant

20. If rst("NumControle") = 1 Then

21. 'Traitement lors du 1er contrôle

22. '-------------------------------

23. 'cumul lait = Lait du contrôle multiplié par la durée de lactation

24. rst("CumulLait") = rst("Lait") * rst("DureeLacta")

25. 'Moyenne TB =

26. rst("MoyTB") = rst("TB")

27. rst("MoyTP") = rst("TP")

29. ElseIf IsNull(DLookup("tVLFk", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))) Then

30. 'Traitement pour les vaches qui apparaissent la 1re fois avec un N°>1

31. '--------------------------------------------------------------------

32. rst("CumulLait") = Null

33. 'Moyenne TB =

34. rst("MoyTB") = Null

35. rst("MoyTP") = Null

37. Else

38. 'Traitement en régime de croisière

39. '---------------------------------

40. 'Vérifier que les contrôles se suivent

41. If rst("NumControle") - DLookup("NumControle", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")) <> 1 Then

42. lReponse = MsgBox("Processus stoppé, car l'ordre des contrôles n'est pas respecté " & vbLf _

43. & "pour la VL " & rst("NomBovide") & vbLf _

44. & "dans le fichier " & obFichier.Name & "." & vbLf _

45. & "Voulez-vous continuer (sans les cumuls pour cette vache) ?", _

46. vbQuestion + vbYesNo + vbDefaultButton1)

48. If lReponse = vbNo Then

49. 'Journaliser le refus de continuer

50. DoCmd.SetWarnings False

51. DoCmd.RunSQL "INSERT INTO tJournal ( Fichier, Quand, Evenement,NivGrave ) " _

52. & "SELECT """ & obFichier.Name & """ AS Expr1, Now() AS Expr2, " _

53. & """Manque de continuité dans les N° des contrôles de la vache " _

54. & rst("NomBovide") & ". Avec arrêt."" AS Expr3, 2 as Expr4;"

55. DoCmd.SetWarnings True

56. Cumuls = False

57. Exit Function

58. Else

59. 'Journaliser l'anomalie et décision de continuer

60. DoCmd.SetWarnings False

61. DoCmd.RunSQL "INSERT INTO tJournal ( Fichier, Quand, Evenement,NivGrave ) " _

62. & "SELECT """ & obFichier.Name & """ AS Expr1, Now() AS Expr2, " _

63. & """Manque de continuité dans les N° des contrôles de la vache " _

64. & rst("NomBovide") & ". Avec poursuite."" AS Expr3, 1 as expr4;"

65. DoCmd.SetWarnings True

66. rst("CumulLait") = Null

67. rst("MoyTB") = Null

68. rst("MoyTP") = Null

69. GoTo MaJEtSuivant

70. End If

71. End If

72. 'Nouveau lait produit = Moyenne entre lait(C) et lait(C-1)

73. 'Cumul lait = NouveauLait + Cumul(C-1)

74. rst("CumulLait") = (rst("Lait") + DLookup("Lait", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))) / 2 * NbreJrsCtlPrec _

75. + DLookup("CumulLait", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))

76. 'Moyenne TB = MoyTB(C-1)*CumulLait(C-1)

77. '                + Nouveau lait multiplié par la moyenne entre TB(C) et TB(C-1)

78. '             le tout divisé par CumulLait(C)

79. rst("MoyTB") = (DLookup("MoyTB", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")) _

80. * DLookup("CumulLait", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")) _

81. + (rst("TB") + DLookup("TB", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))) / 2 _

82. * NbreJrsCtlPrec * rst("Lait")) / rst("CumulLait")

83. 'Moyenne TP = MoyTP(C-1)*CumulLait(C-1) + Nouveau Lait * Moyenne entre TP(C) et TP(C-1)

84. '             le tout divisé par CumulLait(C)

85. rst("MoyTP") = (DLookup("MoyTP", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")) _

86. * DLookup("CumulLait", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk")) _

87. + (rst("TP") + DLookup("TP", "rDerCtlEnregistre", "tVLFk=" & rst("tVLFk"))) / 2 _

88. * NbreJrsCtlPrec * rst("Lait")) / rst("CumulLait")

89. End If

90. MaJEtSuivant:

91. rst.Update

92. rst.MoveNext

93. Loop

94. 'Libérer la mémoire et sortir

95. rst.Close

96. Set rst = Nothing

97. GestionErreurs:

98. Select Case Err.Number

99. Case 0 ' pas d'erreur

100. Exit Function

101. Case Else

102. MsgBox "Erreur dans Cumuls : " & Err.Number & "-" & Err.Description & ".", vbCritical

103. End Select

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

1. Public Function FichierEstOK(obFichier As Scripting.File) As Boolean

2. On Error GoTo GestionErreurs

3. Dim obTS As TextStream

4. Dim sLigne1 As String

5. Dim DateTxt As String

6. Dim DateFichier As Date

7. Dim sEleveur As String

8. FichierEstOK = True

9. 'Vérifier la structure des fichiers csv

10. '--------------------------------------

11. If Right(obFichier.Name, 3) = "csv" Then

12. Set obTS = obFichier.OpenAsTextStream(ForReading)

13. sLigne1 = obTS.ReadLine

14. If sLigne1 <> "COPAIP;NUNATI;CORABO;NOBOVI;NUTRAV;NULACT;NUCONT;LAIT;BAISSE;TB;TP;BILEUC;LEUCO;VELAGE;DULACT;CULAIT;MYTBLA;MYTPLA;CULAST" Then

15. 'Si le contenu n'a pas la structure conforme, journaliser et provoquer l'arrêt

16. DoCmd.SetWarnings False

17. DoCmd.RunSQL "INSERT INTO tJournal ( Fichier, Quand, Evenement ) " _

18. & "SELECT """ & obFichier.Name & """ AS Expr1, Now() AS Expr2, " _

19. & """Structure non conforme"" AS Expr3;"

20. DoCmd.SetWarnings True

21. FichierEstOK = False

22. End If

23. 'Libérer

24. Set obTS = Nothing

25. End If

26. 'Vérifier le bon ordre chronologique

27. '-----------------------------------

28. DateFichier = DateSerial(Left(obFichier.Name, 4), Mid(obFichier.Name, 5, 2), Mid(obFichier.Name, 7, 2))

29. DateTxt = Mid(obFichier.Name, 5, 2) & "/" & Mid(obFichier.Name, 7, 2) & "/" & Left(obFichier.Name, 4)

30. sEleveur = Mid(obFichier.Name, 10, 6)

31. 'Vérifier que la date du fichier est postérieure

32. 'au dernier contrôle enregistré pour cet éleveur

33. If DateFichier <= DLookup("DateDerControle", "tEleveurs", "NumEleveur='" & sEleveur & "'") Then

34. DoCmd.SetWarnings False

35. DoCmd.RunSQL "INSERT INTO tJournal ( Fichier, Quand, Evenement ) " _

36. & "SELECT """ & obFichier.Name & """ AS Expr1, Now() AS Expr2, " _

37. & """La date du fichier n'est pas postérieure à celle de la précédente MàJ"" AS Expr3;"

38. DoCmd.SetWarnings True

39. FichierEstOK = False

40. End If

41. GestionErreurs:

42. Select Case Err.Number

43. Case 0 ' pas d'erreur

44. Exit Function

45. Case Else

46. MsgBox "Erreur dans FichierEstOK : " & Err.Number & "-" & Err.Description & ".", vbCritical

47. End Select

48. 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 !

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.