Calculer l'âge exact en VBA Access, différence de dates

Pour partager cette vidéo sur les réseaux sociaux ou sur un site, voici son url :


Sujets que vous pourriez aussi aimer :


Calculer l'âge en VBA Access

Nous avons déjà exploité la fonction DateDif avec Excel pour calculer des écarts entre deux dates. En VBA Access, elle prend un f de plus. Elle se nomme DateDiff. Son fonctionnement est similaire. Avec cette nouvelle astuce, nous allons l'utiliser pour calculer l'âge de personnes référencées en base de données.



Sur l'exemple illustré par la capture, nous faisons défiler les commerciaux d'une entreprise à l'aide d'une barre de navigation personnalisée. Pour chacun, la date de naissance est renseignée dans un champ situé en avant dernière position. Instantanément, l'âge de chaque personne est calculé par le code VBA et retranscrit dans la dernière zone de texte, juste au-dessus de la barre de navigation. Et comme vous pouvez le voir, la précision descend jusqu'au nombre de jours.

Base de données Access à télécharger
Pour la mise en place de cette nouvelle astuce, nous proposons d'appuyer l'étude sur une base de données offrant déjà ce formulaire permettant de faire défiler les commerciaux.

• Télécharger le fichier compressé calculer-age.rar en cliquant sur ce lien,
• Le décompresser dans le dossier de votre choix,
• Double cliquer sur le fichier résultant pour l'ouvrir dans Access,
• Cliquer sur le bouton Activer le contenu du bandeau de sécurité pour libérer les ressources,
• Dans le volet de navigation sur la gauche, double cliquer sur le formulaire fCommerciaux,

Nous l'affichons ainsi en mode exécution. En cliquant sur le bouton Enregistrement Suivant de la barre de navigation personnalisée, vous faites effectivement défiler les commerciaux. Pour chacun, la date de naissance s'affiche bien dans l'avant dernier Champ. En revanche et bien sûr à ce stade, l'information sur l'âge calculé n'apparaît pas encore dans le tout dernier champ. Il s'agit bel et bien de l'enjeu de cette astuce.

Déclencher un code VBA au défilement
Pour forcer le calcul de l'âge en fonction de la date de naissance de chaque commercial, nous devons être en mesure de déclencher un code VBA à chaque changement d'enregistrement. Cet événement est détecté à chaque fois que le formulaire est activé.

• A gauche du ruban Accueil, cliquer sur la flèche du bouton Affichage,
• Dans les propositions, choisir le mode Création,
• Cliquer à l'intersection des règles en haut à gauche du formulaire,

C'est ainsi que le carré grisé se noircit et que nous désignons le formulaire dans sa globalité. C'est effectivement un événement qui lui est associé que nous devons gérer.

• Dès lors, activer l'onglet Evénement de sa feuille de propriétés,

Si elle n'est pas visible dans votre environnement, vous devez l'afficher. Pour cela, vous devez cliquer sur le bouton Feuille de propriétés dans le ruban Création.

• Maintenant, cliquer sur le petit bouton à l'extrémité de son événement Sur activation,
• Dans la boîte de dialogue qui suit, choisir le générateur de code et valider par Ok,

Nous basculons ainsi dans l'éditeur de code VBA Access entre les bornes de la procédure événementielle Form_Current. Son code se déclenchera à chaque activation du formulaire, notamment à chaque changement d'enregistrement. Vous notez de même la présence d'une fonction signée, nommée calculAge. Elle attend deux paramètres. Il s'agit de la date anniversaire et de la date actuelle.

Function calculAge(dateAnniv As Variant, dateM As Variant) As Variant

End Function

Private Sub Form_Current()

End Sub

C'est elle que nous devons développer pour calculer l'âge exact en nombre d'années, de mois et de jours. En conséquence, la procédure Form_Current doit se contenter de l'appeler en lui passant ces deux dates.

• Dans les bornes de la procédure événementielle, inscrire l'instruction VBA suivante :

Private Sub Form_Current()
c_age.Value = calculAge(c_date.Value, Now)
End Sub

c_age est le nom du dernier champ, celui dans lequel nous devons afficher l'âge exact du commercial en cours de consultation depuis le formulaire. Sa propriété Value permet d'accéder à son contenu dans le but de l'affecter et c'est ce que nous faisons (=). Pour cela, nous appelons la fonction calculAge. En premier paramètre, nous lui passons la date d'anniversaire du commercial en cours. En effet, le nom de l'avant dernier champ est c_date. Tout cela, vous pouvez le constater en consultant la feuille de propriétés après avoir sélectionné l'un ou l'autre contrôle sur le formulaire. En second paramètre, nous lui passons la date en cours grâce à la fonction VBA Now.

La déclaration des variables
Maintenant, il s'agit de développer cette fonction calculAge. Premièrement, nous avons besoin de deux variables. La première doit restituer le nombre de jours passés depuis la date anniversaire. La seconde doit restituer le nombre de mois. Le nombre d'années quant à lui se déduira automatiquement des calculs entrepris.

• Dans les bornes de la fonction calculAge, ajouter les deux déclarations suivantes :

Function calculAge(dateAnniv As Variant, dateM As Variant) As Variant
Dim nbMois As Integer
Dim nbJours As Integer

End Function

Nous déclarons donc ces variables comme des nombres entiers standards.

La différence en nombre de mois
Pour calculer correctement la différence en nombre de mois complets, nous devons savoir si le jour du mois pour la date d'anniversaire est supérieur au jour du mois pour la date en cours. En effet, en fonction du cas, un ajustement est nécessaire.

• A la suite de la fonction, ajouter l'instruction VBA suivante :

...
nbMois = DateDiff("m", dateAnniv, dateM) + (Day(dateM) < Day(dateAnniv))
...

Grâce à la fonction DateDiff, nous calculons l'écart en nombre de mois ("m") entre la date d'anniversaire (dateAnniv) et la date en cours (dateM). Mais imaginez par exemple une personne née un 5 mars alors que nous sommes le 3 Avril. Le mois non achevé est considéré dans la différence puisqu'il n'est plus le même . L'addition qui suit est une astuce (Day(dateM) < Day(dateAnniv)). Elle répond par un booléen qui vaut -1 si true, donc si le jour de la date en cours est inférieur à celui de l'anniversaire et 0 si false. C'est ainsi que le mois potentiellement en trop est soustrait. Vous l'aurez compris, Day est une fonction VBA qui renvoie le jour dans le mois pour la date qui lui est passée en paramètre.

La différence en nombre de jours
La problématique est similaire pour calculer l'écart en nombre de jours, selon que le jour du mois de la date en cours est supérieur ou inférieur au jour du mois de la date d'anniversaire.

• A la suite du code de la fonction, ajouter l'instruction conditionnelle suivante :

...
If Day(dateM) < Day(dateAnniv) Then
nbJours = DateDiff("d", dateAnniv, DateSerial(Year(dateAnniv), Month(dateAnniv) + 1, 0)) + Day(dateM)
Else
nbJours = Day(dateM) - Day(dateAnniv)
End If
...

Si le jour du mois pour la date en cours est inférieur au jour du mois pour la date anniversaire, nous calculons un écart réajusté. Pour cela, nous exploitons tout d'abord la fonction DateDiff avec la lettre d en premier paramètre pour réaliser cette différence sur les jours. Puis, nous calculons cet écart entre la date d'anniversaire (dateAnniv) et cette même date ramenée au premier jour précédent le mois suivant grâce à la fonction DateSerial. Celle-ci renvoie une date en fonction des informations qui lui sont passées pour l'année Year (dateAnniv), pour le mois majoré (Month(dateAnniv) + 1) et pour le jour (0). Avec 0, nous passons du 01 Avril au 31 Mars suite à quoi nous ajoutons les jours de la date en cours (Day(dateM)). En effet, toujours dans le cas du 5 Mars pour l'anniversaire alors que nous sommes le 3 Avril, Il faut 26 jours pour rejoindre le 31 Mars + 3 jours soit 29 jours pour rejoindre le 3 Avril.

Calculer l'âge exact
Il ne nous reste plus qu'à exploiter ces résultats, à ajuster encore pour certains, afin de délivrer l'âge exact de la personne, dans le tout dernier champ. Et pour cela, c'est par son propre nom qu'une fonction VBA retourne la valeur calculée.

• A la suite de la fonction, ajouter l'instruction VBA suivante :

...
calculAge = LTrim(Str(nbMois \ 12)) & " ans " & LTrim(Str(nbMois Mod 12)) & " mois " & LTrim(Str(nbJours)) & " jours"
...

A chaque reprise, nous exploitons la fonction Str pour convertir en chaîne de texte l'information numérique qui lui est passée en paramètre. Cette fonction va laisser un espace en préfixe. C'est la raison pour laquelle nous l'englobons dans la fonction LTrim. Cette dernière purge les espaces placés en entête. Dans le premier calcul, nous divisons le nombre de mois par 12. Il en résulte un nombre réel correspondant à l'âge en années comme par exemple 36,3 pour 36 ans. Mais grâce à l'astuce subtile de l'antislash (\) à la place du slash (/), nous ne conservons que la partie entière, soit 36 que nous concaténons avec le texte ans. Dans le deuxième calcul, nous exploitons la fonction Mod avec la valeur 12 sur le nombre total de mois séparant les 2 dates. Nous obtenons ainsi le reste du nombre de mois après avoir restitué le nombre d'années. Nous associons cette information au texte mois. Dès lors, il ne nous reste plus qu'à assembler l'écart en nombre de jours que nous avions déjà réajusté. Il est temps de tester le bon fonctionnement de ce calcul minutieux.

• Enregistrer les modifications (CTRL + S) et basculer sur le formulaire (ALT + Tab),
• Exécuter ce dernier avec la touche F5 du clavier,
• Puis, faire défiler les commerciaux en cliquant sur le bouton Enregistrement suivant,

Comme vous pouvez l'apprécier, l'âge exact est très précis est en effet calculé pour chacun. Le code VBA complet que nous avons développé pour calculer l'écart entre deux dates est le suivant :

Function calculAge(dateAnniv As Variant, dateM As Variant) As Variant
Dim nbMois As Integer
Dim nbJours As Integer

nbMois = DateDiff("m", dateAnniv, dateM) + (Day(dateM) < Day(dateAnniv))

If Day(dateM) < Day(dateAnniv) Then
nbJours = DateDiff("d", dateAnniv, DateSerial(Year(dateAnniv), Month(dateAnniv) + 1, 0)) + Day(dateM)
Else
nbJours = Day(dateM) - Day(dateAnniv)
End If

calculAge = LTrim(Str(nbMois \ 12)) & " ans " & LTrim(Str(nbMois Mod 12)) & " mois " & LTrim(Str(nbJours)) & " jours"

End Function

Private Sub Form_Current()
c_age.Value = calculAge(c_date.Value, Now)
End Sub