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
|
Option Compare Database
Option Explicit:'S'assure que les variables sont déclarées avant d'être utilisées.
'Ça c'est un peu 'overkilling' M et F sont des literraux assez évidents pour désigner les sexes mais c'est une pratique recommandée de mettre des constantes en lieux et place des literraux.
' De plus quand on lit SEXE_MALE il n'y a aucun doute qu'on se refère au sexe alors que "M" pourrait signifier "Modification" ou "Maternité" ou "Maman"
Public Const SEXE_MALE As String = "M"
Public Const SEXE_FEMELLE As String = "F"
'Dans une requête on ne peut pas lire une constante mais on peut appeler une fonction publique.
'Ceci permet d'accéder à la constante à partir d'une requête.
'Attention ce procédé peut accroitre grandement le temps de calcul d'une requête.
Public Function LireSexeMale() As String
LireSexeMale = SEXE_MALE
End Function
Public Function LireSexeFemelle() As String
LireSexeFemelle = SEXE_FEMELLE
End Function
Public Function LireAscendantMale(prmClefAnimal As Variant) As String
'Pour l'animal passé en paramêtre, donne le nom de son père, son grand père, etc...
Dim result As String
'trouve la clef de l'animal père
Dim clefPere As Variant
clefPere = DFirst("ClefAnimalPere", "Animal", "[ClefAnimal]=" & prmClefAnimal)
Call CalculerAscendant(clefPere, SEXE_MALE, result)
LireAscendantMale = result
End Function
Public Function LireAscendantFemelle(prmClefAnimal As Variant) As String
'Pour l'animal passé en paramêtre, donne le nom de sa mère, sa grand mère, etc...
Dim result As String
'trouve la clef de l'animal mère
Dim clefMere As Variant
clefMere = DFirst("ClefAnimalMere", "Animal", "[ClefAnimal]=" & prmClefAnimal)
Call CalculerAscendant(clefMere, SEXE_FEMELLE, result)
LireAscendantFemelle = result
End Function
Private Sub CalculerAscendant(prmClefAnimalParent As Variant, prmSexeLignee As String, ByRef prmListeAcsendant As String)
'Attention cette procédure modifie prmListeAscendantMale
'Donne la liste des ascendants
If IsNull(prmClefAnimalParent) Then
'Il n'y a plus de parent connu ou on ne sait pas de quel sexe il est
'on peut arreter la recherche ici
Exit Sub
End If
'trouve le nom du père
Dim nomParent As String
nomParent = Nz(DFirst("Nom", "Animal", "[ClefAnimal]=" & prmClefAnimalParent), "")
'Ajoute le père à la liste des ascendants
If prmListeAcsendant <> "" Then
'Si il y a déjà des ascendants, ajoute une séparation
prmListeAcsendant = "\" & prmListeAcsendant
End If
prmListeAcsendant = nomParent & prmListeAcsendant
'Trouve le père du père
Dim clefAnimalGrandParent As Variant
Select Case prmSexeLignee
Case SEXE_MALE
clefAnimalGrandParent = DFirst("ClefAnimalPere", "Animal", "[ClefAnimal]=" & prmClefAnimalParent)
'Calcule les ascendants du grand père
Call CalculerAscendant(clefAnimalGrandParent, prmSexeLignee, prmListeAcsendant)
Case SEXE_FEMELLE
clefAnimalGrandParent = DFirst("ClefAnimalMere", "Animal", "[ClefAnimal]=" & prmClefAnimalParent)
'Calcule les ascendants du grand père
Call CalculerAscendant(clefAnimalGrandParent, prmSexeLignee, prmListeAcsendant)
Case Else
'Cas normalement impossible mais c'est une bonne habitude quand on utilise un Select case dont
' on sait par avance quelles seront toutes les réponses.
' Si on ajoute un code par la suite et qu'on oublie le Select case
' on va l'attraper à l'execution on aura pas de cas fourre tout.
Error 5
End Select
End Sub |
Partager