Gérer un troupeau de moutons avec Access

Public Function Categorie(OvinPK As Long, DateDemande As Date) As String
  On Error GoTo GestionErreurs
  Dim iSexe As Integer
  Dim dNaissance As Date
  Dim d1erAnniv As Date
  
  'Son sexe
  iSexe = DLookup("tSexesFK", "tOvins", "tOvinsPK=" & OvinPK)
  
  'Sa date de naissance
  dNaissance = DLookup("DateNaiss", "tOvins", "tOvinsPK=" & OvinPK)
  If dNaissance > DateDemande Then Categorie = "Pas né !": Exit Function
  
  'Son 1er anniversaire
  d1erAnniv = DateSerial(Year(dNaissance) + 1, Month(dNaissance), Day(dNaissance))
  
  'Sa catégorie à la date demandée
  If d1erAnniv > DateDemande Then  '1° Traitement si pas encore adulte
      If iSexe = 1 Then
          Categorie = "Agnelle": Exit Function
        Else
          Categorie = "Agneau": Exit Function
      End If
  
    Else                                             '2° Traitement si adulte
      If iSexe = 1 Then
          Categorie = "Brebis": Exit Function
        Else
          Categorie = "Bélier"
      End If
  End If

GestionErreurs:
  Select Case Err.Number
    Case 0 'pas d'erreur
      Exit Function
    Case 94 'Pas trouvé dans tOvins
      MsgBox " La clé : " & OvinPK & " n'est pas trouvée dans tOvins", vbInformation
      Exit Function
    Case Else
      MsgBox "Erreur dans Categorie N° " & Err.Number & " " & Err.Description
  End Select
End Function

Les commentaires inclus dans le code rendent celui-ci suffisamment compréhensible, même pour un non-initié.

Pour un problème de compréhension du code dans un module, placez le curseur n'importe où dans l'instruction et pressez <F1>. L'aide Access s'ouvre alors à la bonne page.

'comme ceci :
Categorie = "Agnelle": Exit Function

'au lieu de ceci :
Categorie = "Agnelle" 
Exit Function

Il s'agit d'un formulaire indépendant : il n'a pas de source.

Les cellules en vert sont alimentées soit :

- à l'aide d'une fonction de domaine :

- par combinaison d'autres contrôles :

fInventaire contient deux sous-formulaires (sfInvenSorties et sfInvenEntrees) qui donnent le détail des sorties et des entrées.

IV-B-1. tInvenEntrees et tInvenEntrees▲

L'ouverture du formulaire provoque la création de deux tables tInvenEntrees et tInvenEntrees.

 

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.

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
  Call Rafraichir
End Sub

Public Sub Rafraichir()
  Dim ctl As Control
  Dim sSql As String
  
  'Recréer la table tInvenEntrees
  sSql = "SELECT categorie([tOvinsPK],[DateEntree]) AS Categorie, tOvins.* INTO tInvenEntrees " _
          & "FROM tOvins " _
          & " WHERE tOvins.DateEntree>=#" & Format([Forms]![fInventaire]![txtDebut], "mm/dd/yy") & "# " _
                & "And tOvins.DateEntree<=#" & Format([Forms]![fInventaire]![txtFin], "mm/dd/yy") & "#" _
                & "And tOvins.Fictif=False;"
  DoCmd.SetWarnings False
  DoCmd.RunSQL sSql
  DoCmd.SetWarnings True
  For Each ctl In Me.Controls
    If ctl.Name Like "txt*" Or ctl.Name Like "CTNRsf*" Then ctl.Requery
  Next ctl
  
  'Recréer la table tInvenSorties
  sSql = "SELECT categorie([tOvinsPK],[DateSortie]) AS Categorie, tOvins.* INTO tInvenSorties " _
           & "FROM tOvins " _
           & "WHERE tOvins.DateSortie >=#" & Format([Forms]![fInventaire]![txtDebut], "mm/dd/yy") & "# " _
                      & "AND tOvins.DateSortie <=#" & Format([Forms]![fInventaire]![txtFin], "mm/dd/yy") & "# " _
                      & "AND tOvins.tCausesSortieFK<>6 " _
                      & "And tOvins.Fictif=False;"
  DoCmd.SetWarnings False
  DoCmd.RunSQL sSql
  DoCmd.SetWarnings True
End Sub

Commentaires du code

13-17 : par exemple si la période est exprimée comme ceci :

la requête construite à la volée correspond à ceci :

26-31 : la requête construite à la volée correspond à ceci :

Ces deux tables sont supprimées lors de la fermeture du formulaire.

 

Sélectionnez

Private Sub Form_Close()
  'Supression des tables tInvenEntrees et tInvenSorties
  DoCmd.DeleteObject acTable, "tInvenEntrees"
  DoCmd.DeleteObject acTable, "tInvenSorties"
End Sub

Nous utiliserons aussi quatre requêtes enregistrées :

IV-B-2. rInvenDebut▲

IV-B-3. rInvenFin▲

IV-B-4. rInvenAgneauxVersBeliers▲

Il s'agit de détecter les mâles qui durant la période sont passés à l'âge adulte.

C'est l'union de deux requêtes :

- la première ramène les mâles présents pendant toute la période qui ont changé de catégorie :

- la seconde ramène les agneaux entrés pendant la période devenus adultes à la fin de celle-ci :

L'union des deux requêtes s'écrit comme ceci

rInvenAgneauxVersBeliers

Sélectionnez

SELECT rInvenDebut.tOvinsPK
FROM rInvenDebut INNER JOIN rInvenFin ON rInvenDebut.tOvinsPK = rInvenFin.tOvinsPK
WHERE (((rInvenDebut.Categorie)="agneau") AND ((rInvenFin.Categorie)="bélier")) UNION SELECT tOvins.tOvinsPK
FROM tOvins INNER JOIN rInvenFin ON tOvins.tOvinsPK = rInvenFin.tOvinsPK
WHERE (((tOvins.DateEntree)>[Formulaires]![fInventaire]![txtDebut]) AND ((tOvins.DateSortie)>[Formulaires]![fInventaire]![txtFin] Or (tOvins.DateSortie) Is Null) AND ((Categorie([tOvins].[tOvinsPK],[tOvins].[DateEntree]))="Agneau") AND ((rInvenFin.Categorie)="Bélier"));

IV-B-5. rInvenAgnellesVersBrebis▲

SELECT rInvenDebut.tOvinsPK
FROM rInvenDebut INNER JOIN rInvenFin ON rInvenDebut.tOvinsPK = rInvenFin.tOvinsPK
WHERE (((rInvenDebut.Categorie)="agnelle") AND ((rInvenFin.Categorie)="brebis")) UNION SELECT tOvins.tOvinsPK
FROM tOvins INNER JOIN rInvenFin ON tOvins.tOvinsPK = rInvenFin.tOvinsPK
WHERE (((tOvins.DateEntree)>[Formulaires]![fInventaire]![txtDebut]) AND ((tOvins.DateSortie)>[Formulaires]![fInventaire]![txtFin] Or (tOvins.DateSortie) Is Null) AND ((Categorie([tOvins].[tOvinsPK],[tOvins].[DateEntree]))="Agnelle") AND ((rInvenFin.Categorie)="Brebis"));

IV-C-1. Source▲

Source de sfInvenSorties

Sélectionnez

SELECT tCausesSortie.CauseSortie, DCount("*","tInvenSorties","Categorie='Agnelle' AND tCausesSortieFK=" & [tCausesSortiePK]) AS Agnelles, DCount("*","tInvenSorties","Categorie='Brebis' AND tCausesSortieFK=" & [tCausesSortiePK]) AS Brebis, DCount("*","tInvenSorties","Categorie='agneau' AND tCausesSortieFK=" & [tCausesSortiePK]) AS Agneaux, DCount("*","tInvenSorties","Categorie='Bélier' AND Fictif = false AND tCausesSortieFK=" & [tCausesSortiePK]) AS Beliers FROM tCausesSortie WHERE (((tCausesSortie.tCausesSortiePK)<>6)) ORDER BY tCausesSortie.OrdreInven;

Sa construction est calquée sur celle de sfInvenSorties.

Tout comme le formulaire précédent, fRepro n'a pas de source.

Les contrôles du formulaire sont alimentés soit :
- par des fonctions de domaine (sur des requêtes décrites plus bas) ;
- soit par combinaison d'autres contrôles :

Pour éviter les cas où on serait amené à diviser par zéro :

Public Function ZeroToUn(Diviseur As Double) As Double
  'Pour éviter de diviser par zéro
  If Diviseur = 0 Then
      ZeroToUn = 1
    Else
      ZeroToUn = Diviseur
  End If
End Function

Diviser un nombre par un, ça ne mange pas de pain !

Nous utilisons sept requêtes enregistrées pour préparer les données que nous importerons ensuite dans le formulaire à l'aide de fonctions de domaine :

V-B-1. rRepro01FemellesPresentes▲

Remarquez les deux lignes de critères :

Cette requête va ramener deux sortes d'enregistrements :

- ceux qui vérifient les conditions de la 1^re ligne ;

ET

- ceux qui vérifient les conditions de la seconde.

Commentaires des colonnes

On ramène uniquement les femelles.

Il s'agit de la catégorie (agnelle ou brebis) au début de la saison.

et expriment que cette femelle était entrée avant le début et que, si elle est sortie, c'est après le début.

Avec Nz() on substitue à la valeur Null éventuelle de DateSortie une date loin dans le futur (en l'occurrence 1/1/2100). Cela nous épargne de devoir traiter un VraiFaux() supplémentaire.

On exclut du bilan de reproduction les femelles qui ont été destinées à la boucherie.

Il s'agit des femelles entrées dans le troupeau en cours de saison, MAIS évidemment pas les agnelles nouveau-nées de cette saison !

V-B-2. rRepro02MisesEnLutte▲

Parmi les femelles ramenées par la requête rRepro01FemellesPresentes, on retient celles qui ont été mises en lutte durant la période.

V-B-3. rRepro03Agnelages▲

Pour chaque femelle mise en lutte durant la période, on ramène une ligne par femelle ayant mis bas.

V-B-4. rRepro04Agnele2X▲

Parmi les femelles de la requête rRepro03Agnelages, on ramène celles qui y figurent plus d'une fois.

(Sachant qu'une gestation dure environ 150 jours et qu'un délai de 75 jours sépare une mise bas et la mise en lutte suivante, en pratique deux mises bas par saison est un maximum.)

V-B-5. rRepro05Improductives▲

Cette requête va donc ramener les femelles présentes qui ne se retrouvent pas parmi celles ayant mis bas.

V-B-6. rRepro06AgneauxNes▲

Cette requête ramène donc les nouveau-nés pour chaque agnelage intervenu durant la saison.

V-B-7. rRepro07AgneauxMorts▲

Désolé de terminer cette liste sur une note triste…

Option Compare Database
Option Explicit

Private Sub txtDebut_AfterUpdate()
  Dim ctl As Control
  Me.txtFin = DateSerial(Year(Me.txtDebut) + 1, Month(Me.txtDebut), Day(Me.txtDebut) - 1)
  For Each ctl In Me.Controls
    If ctl.Name Like "txt####" Then ctl.Requery
  Next ctl
End Sub

Private Sub txtFin_AfterUpdate()
  Dim ctl As Control
  Me.txtDebut = DateSerial(Year(Me.txtFin) - 1, Month(Me.txtFin), Day(Me.txtFin) + 1)
  For Each ctl In Me.Controls
    If ctl.Name Like "txt####" Then ctl.Requery
  Next ctl
End Sub

Commentaires du code

À l'ouverture du formulaire, la période indiquée correspond à la dernière saison écoulée. 

L'utilisateur peut changer cette période à la condition que ce qu'il propose corresponde à une durée de 1 an.

6 et 14 : après mise à jour d'une des deux dates, l'autre est automatiquement adaptée pour que l'écart entre début et fin soit d'une année.

7-9 et 15-17 : on réactualise la valeur des contrôles de données (que nous avons pris la précaution de nommer « txt » suivi de quatre chiffres).

Cette requête ramène donc toutes les colonnes de la table tOvins, la catégorie de l'animal à la date indiquée dans le formulaire, la race en clair et la date de sortie (éventuelle).

Pour les ovins (non fictifs) qui étaient présents à cette date (déjà entrés et pas encore sortis).

Les lignes sont triées de manière à présenter dans l'ordre : les brebis, les agnelles, les béliers et les agneaux et, à l'intérieur des catégories, par numéro de travail.

Chaque catégorie s'affiche dans une couleur qui lui est propre

En arrière-plan nous avons une zone de texte indépendante txtCategorie dont la couleur de fond originale correspond à celle choisie pour les agneaux et que nous modifions grâce à la mise en forme conditionnelle en fonction de la valeur de la colonne [Categorie] de chaque enregistrement.

Les autres contrôles sont superposés à cette zone de texte et leur propriété Style fond a la valeur « Transparent » :

Cette astuce donne l'illusion que les lignes du formulaire sont colorées selon la catégorie.

Remarquez que le texte sur les lignes des béliers s'affiche en blanc :

Pour afficher le nombre dans chaque catégorie

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
  Me.Requery
End Sub

Private Sub txtDate_AfterUpdate()
  Me.Requery
End Sub

Après chaque modification de la date, on provoque la réactualisation du formulaire.

N.B. À l'ouverture, il faut aussi actualiser, sinon on obtiendrait ceci :

Cela tient au fait qu'Access attribue la source à un instant où il n'a pas encore aménagé la valeur par défaut de txtDate. La requête rfPresentsADate ne ramène donc aucun enregistrement (txtDate étant Null).