Age

Résolu
Signaler
Messages postés
710
Date d'inscription
jeudi 20 février 2003
Statut
Membre
Dernière intervention
19 mai 2015
-
Messages postés
710
Date d'inscription
jeudi 20 février 2003
Statut
Membre
Dernière intervention
19 mai 2015
-
bonjour
voila sur le site j'ai trouvé se code pour calculé l'age par rapport àune date :
le code :
Private Sub Command1_Click()
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim d As Integer
Dim Jours As Integer
Dim Mois As Integer
Dim Années As Integer



A = Left(Text1.Text, 2)
B = Mid(Text1.Text, 4, 2)
C = Right(Text1.Text, 4)
X = Format$(Now, "DD")
Y = Format$(Now, "MM")
Z = Format$(Now, "YYYY")



If X - A < 0 Then



Y = Y - 1



    If Y 1 Or Y 3 Or Y = 5 Or Y = 7 Or Y = 8 Or Y = 10 Or Y = 12 Then
    d = 31
    End If



    If Y = 2 Then
        If (IsDate("29/02/" & CStr(Z))) = True Then
            d = 29
        Else
            d = 28
        End If
    End If



    If Y 4 Or Y 6 Or Y = 9 Or Y = 11 Then
        d = 30
    End If



X = X + d



End If



Jours = X - A



If Y - B < 0 Then



Y = Y + 12
Z = Z - 1



End If



Mois = Y - B



Années = Z - C



MsgBox "Vous avez " & Années & " ans ", 48, "AGE"
End Sub
mais est ce possible d'afficher l'age dans un label quand une donnée sera tapé dans un textbox
un truc du genre
Private Sub Text2_Change()


label1.caption= Age
End Sub
merci
@plus
petchy

3 réponses

Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
27
Riens va...
Tu as de la chance : c'est l'heure du pastis, donc de ma meilleure humeur :

Une Form, une textbox nommée datenais et un label nommé Label1

Public Function Age(D1 As Date, D2 As Date) As String
  Dim nba As Integer, nbm As Integer, nbj As Integer
  Dim LaFeinte As Long '  <<======= et.... pour une feinte, ... tu vas voir...
  LaFeinte = IIf(Day(D2) < Day(D1), 1, 0) ' retournera 1 si Day(D2) < Day(D1) sinon 0  nba Year(D2) - Year(D1) - Switch(Month(D2) < Month(D1), 1, Month(D2) Month(D1), LaFeinte, True, 0)
  nbm = (Month(D2) - Month(D1) - LaFeinte + 12) Mod 12 ' <<<==== ...Hé hé !......(zi rigoule)...
  nbj = Day(D2) - Day(D1) + LaFeinte * Day(DateSerial(Year(D2), Month(D2), 1) - 1)
  Age = Trim(IIf(nba > 0, nba & " an" & IIf(nba > 1, "s", "") & " ", "") & _
  IIf(nbm > 0, nbm & " mois ", "") & IIf((nbj > 0) Or (nba + nbm = 0), nbj & " jour" & IIf(nbj > 1, "s", ""), ""))
End Function


Private Sub datenais_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then
     KeyAscii = 0
     If Not IsDate(datenais.Text) Then
        MsgBox "ce n'est pas une date valide !"
        KeyAscii = 0
        Exit Sub
     End If
     Label1.Caption = Age(DateValue(datenais.Text), DateValue(Now))
     KeyAscii = 0
  End If
End Sub

Tu lances, tu rentres une date et tu appuies sue ENTER.

Aller ! A mon pastaga !
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
27
Bonjour),


1) je ne suis pas vraiment d'accord avec tout ce bastringue pour calculer un âge (il y a quand même plus simple)


2) Il ne serait pas sage de lier l'affichage de l'âge à l'événement Change du contr^$ole qui sert à la saisie d'une date de naissance, puisque cet événement interviendra à chaque modification du texte (donc à chaque frappe de touche !)


3) tu peux lier le calcul à la frappe d'une touche (enter par exemple, mais à condition que ta textbox l'accepte - donc multiligne) et reconnaître cette touche au Keypress pour :


     a) vérifier que la date est cohérente


      b) déclencher le calcul et l'affichage de l'âge


4)" label1.caption= Age" ? crée donc une variable Age et donne-lui tout simplement la valeur qui figure dans le msgbox de ton code.

Commence sur ces bases et reviens si tu as une difficulté particulière précise (c'est très facile ...)
Messages postés
710
Date d'inscription
jeudi 20 février 2003
Statut
Membre
Dernière intervention
19 mai 2015
3
salut JM
merci pour tes réponses,tu m'enleve une bonne épine du pied.et si tu passe dans les Ardennes,n'hésite pas à passer pour boire un ou plus   pastaga
bon Week-End
petchy