Age

Résolu
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 - 1 juin 2007 à 17:46
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 - 1 juin 2007 à 18:38
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

jmfmarques Messages postés 7668 Date d'inscription samedi 5 novembre 2005 Statut Membre Dernière intervention 22 août 2014 28
1 juin 2007 à 18:22
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 !
3
jmfmarques Messages postés 7668 Date d'inscription samedi 5 novembre 2005 Statut Membre Dernière intervention 22 août 2014 28
1 juin 2007 à 17:56
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 ...)
0
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 3
1 juin 2007 à 18:38
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
0
Rejoignez-nous