Discussion :

[Vieuxcruton]

Bonjour
J'ai besoin de connaitre, au jour près, l'âge d'une personne à une date précise. (01/09/Millésime)
Dans mon formulaire apparait -le champ "DATE DE NAISSANCE", renseigné
-Une zone de texte "DATE2" , formaté en texte brut, affichant un millésime à partir de ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 Private Sub DATE2_GotFocus()
              Dim currentDate As Date
              Dim currentMonth As Integer
              Dim currentYear As Integer
 
             currentDate = Date
             currentMonth = Month(currentDate)
             currentYear = Year(currentDate)
 
            If currentMonth >= 1 And currentMonth < 12 Then
            Me!DATE2 = currentYear
            Else
 
            Me!DATE2 = currentYear - 1
 
            End If
 
            End Sub
 
 
Ca, ca fonctionne.
                                       - et une zone de texte [Texte20] formaté en texte brut dans laquelle je veux afficher l'âge exact de la personne au 01/09/"DATE2" et pour laquelle j'ai placé ce code :
 
Private Sub Texte20_GotFocus()
    Dim birthDate As Date
    Dim ageYears As Integer
    Dim ageMonths As Integer
    Dim ageDays As Integer
    Dim currentDate As Date
    Dim targetDate As Date
 
    birthDate = Me![Date de naissance]
    currentDate = Date
 
    ageYears = DateDiff("yyyy", birthDate, currentDate)
    ageMonths = DateDiff("m", birthDate, currentDate) Mod 12
    ageDays = DateDiff("d", DateSerial(Year(birthDate), Month(birthDate) + ageMonths, Day(birthDate)), currentDate)
 
    targetDate = DateSerial(Year(Me!DATE2), 9, 1)
 
    ageYears = ageYears - DateDiff("yyyy", targetDate, currentDate)
    ageMonths = ageMonths - DateDiff("m", targetDate, currentDate) Mod 12
    ageDays = ageDays - DateDiff("d", DateSerial(Year(targetDate), Month(targetDate) + ageMonths, Day(targetDate)), currentDate)
 
 
    Me!Texte20 = ageYears & " ans, " & ageMonths & " mois et " & ageDays & " jours"
End Sub

Le résultat est (évidemment) faux : pour ma date de naissance 19/03/1956 et un [DATE2] de 2023 la zone de texte retourne : -51 ans, -6 mois et -18707 jours.
Le résultat est erroné – je ne suis pas une momie - et des jours ne se convertissent pas en mois/ans.
Dans quelle zone dois-je chercher la faille ?
Merci d'avance au courageux qui vont tenter de m'expliquer…

[hyperion13]

Salut
Vous cherchez bien à calculer un âgé fonction d'une date anniversaire et la date en cours !
Dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function calcAge(datedeb As Date, datefin As Date) As String
Dim nbMois As Integer
Dim nbJours As Integer
 
nbMois = DateDiff("m", datedeb, datefin) + (Day(datefin) < Day(datedeb))
 
If Day(datefin) < Day(datedeb) Then
    nbJours = DateDiff("d", datedeb, DateSerial(Year(datedeb), Month(datedeb) + 1, 0)) + Day(datefin)
Else
    nbJours = Day(datefin) - Day(datedeb)
End If
calcAge = LTrim(Str(nbMois \ 12)) & " ans " & LTrim(Str(nbMois Mod 12)) & " mois " & LTrim(Str(nbJours)) & " jours"
 
End Function

via une qry

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Age:calcAge([DateAnniv];Date())

via contrôle source d'une textbox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=calcAge([DateAnniv];Date())

via VBA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Me.txtAge = calcAge([DateAnniv],Date())

[Vieuxcruton]

Bonjour hyperion13 (encore vous! )
Je cherche a calculer l'âge exact à une date donnée (01/09/millésime variable selon le moment du calcul). J'ai peut-être compliqué le code...
En fait un club détermine la catégorie dans laquelle un joueur va évoluer selon son âge au début d'une saison qui commence le 1er septembre A et s'achève le 31 aout A+1.
Le joueur peut être inscrit pendant toute la saison
Le premier code est destiné à faire référence à l'année A jusqu'à la fin de la saison (inscription tardive). Jusque la, tout va bien...

[hyperion13]

re

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function calcAge(datedeb As Date, anneefin As Integer) As String
Dim nbMois As Integer
Dim nbJours As Integer
 
nbMois = DateDiff("m", datedeb, DateSerial(anneefin, 9, 1)) + (Day(DateSerial(anneefin, 9, 1)) < Day(datedeb))
 
If Day(DateSerial(anneefin, 9, 1)) < Day(datedeb) Then
    nbJours = DateDiff("d", datedeb, DateSerial(Year(datedeb), Month(datedeb) + 1, 0)) + Day(DateSerial(anneefin, 9, 1))
Else
    nbJours = Day(DateSerial(anneefin, 9, 1)) - Day(datedeb)
End If
calcAge = LTrim(Str(nbMois \ 12)) & " ans " & LTrim(Str(nbMois Mod 12)) & " mois " & LTrim(Str(nbJours)) & " jours"
 
End Function

via contrôle source d'une textbox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=calcAge([DateAnniv];txtAnnee)

via VBA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Me.txtAge = calcAge([DateAnniv],Me.txtAnnee)

[Vieuxcruton]

Merci beaucoup hypérion13. Deux nuits d'économisée!