cs_Bidou
Messages postés5487Date d'inscriptiondimanche 4 août 2002StatutMembreDernière intervention20 juin 2013
-
20 juil. 2006 à 10:36
SergBobo
Messages postés1Date d'inscriptionmardi 8 juin 2010StatutMembreDernière intervention 8 juin 2010
-
8 juin 2010 à 17:43
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
SergBobo
Messages postés1Date d'inscriptionmardi 8 juin 2010StatutMembreDernière intervention 8 juin 2010 8 juin 2010 à 17:43
age à partir de la date de naissance :
If DateSerial(Year(Date), Month(DateNaissance), Day(DateNaissance)) > Date Then
MyAge = Year(Date) - Year(DateNaissance) - 1
Else
MyAge = Year(Date) - Year(DateNaissance)
End if
cs_AiderMoiSvp
Messages postés4Date d'inscriptionjeudi 4 février 2010StatutMembreDernière intervention 4 février 2010 4 févr. 2010 à 16:18
OK merci beaucoup
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 4 févr. 2010 à 16:04
préciser :
(Nombre de jours entre naissance et date du jour )
???
euh, ben, c'est ...
le nombre de jour entre :
- date de naissance
- date courante
cs_AiderMoiSvp
Messages postés4Date d'inscriptionjeudi 4 février 2010StatutMembreDernière intervention 4 février 2010 4 févr. 2010 à 16:00
Vien tu juste de faire mon programme en plus simplifié? WoW
cs_AiderMoiSvp
Messages postés4Date d'inscriptionjeudi 4 février 2010StatutMembreDernière intervention 4 février 2010 4 févr. 2010 à 15:59
Pourrai tu svp me préciser cette phrase pour moi
(Nombre de jours entre naissance et date du jour )
Je crois que cela ma m'aide beacoup
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 4 févr. 2010 à 15:58
En gros, je dirai :
Private Sub cmdAff_Click()
Dim nDay As Integer
Dim nMonth As Integer
Dim nYear As Integer
Dim bBirth As Date
If Len(txtCod.Text) <> 12 Then
MsgBox "Veuillez entrer votre code permanent", vbExclamation
ElseIf Not txtCod.Text Like "*[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres", vbExclamation
ElseIf Not txtCod.Text Like "[A-Z][A-Z][A-Z][A-Z]*" Then
MsgBox "Les quatres premier caracteres doivent etre des lettres", vbExclamation
Else
nDay = Val(Mid$(txtCod.Text, 5, 2))
nMonth = Val(Mid$(txtCod.Text, 7, 2))
nYear = Val(Mid$(txtCod.Text, 9, 2))
dBirth = DateSerial(nYear, nMonth, nDay)
lblMois.Caption = MonthName(nMonth)
If nMonth <= 12 Then
lblSexe.Caption = "Masculin"
Else
lblSexe.Caption = "Féminin"
End If
lblAge.Caption = CLng((Date - dBirth) / 365.25)
End If
End Sub
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 4 févr. 2010 à 15:46
y'a 9 fois plus de code qu'il n'en suffit ...
Age = (Nombre de jours entre naissance et date du jour ) / 365.25
cs_AiderMoiSvp
Messages postés4Date d'inscriptionjeudi 4 février 2010StatutMembreDernière intervention 4 février 2010 4 févr. 2010 à 15:20
Bonjour, j'ai grand besoin de vos expertise.
Je doit finir mon programme d'ici une semaine qui constitue a trouver la date de naissance, l'âge et le sexe de la personne juste en sachant son code permanent. Voici mon code et voici mon problème je suis incapable de trouver l'age .
Option Explicit
Private Sub cmdAff_Click()
Dim iCod As String
Dim iCod2 As String
Dim iCod3 As String
Let iCod = Mid(txtCod.Text, 7, 2) ' Numérise le mois
Let iCod2 = Mid(txtCod.Text, 5, 2) 'Numérise le jours
Let iCod3 = Mid(txtCod.Text, 9, 2) 'Numérise l'annee
If txtCod.Text = "" Then
MsgBox "Veuillez entrer votre code permanent"
Else
If UCase(Mid(txtCod.Text, 5, 1)) >= "A" And UCase(Mid(txtCod.Text, 5, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 6, 1)) >= "A" And UCase(Mid(txtCod.Text, 6, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 7, 1)) >= "A" And UCase(Mid(txtCod.Text, 7, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 8, 1)) >= "A" And UCase(Mid(txtCod.Text, 8, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 9, 1)) >= "A" And UCase(Mid(txtCod.Text, 9, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 10, 1)) >= "A" And UCase(Mid(txtCod.Text, 10, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 11, 1)) >= "A" And UCase(Mid(txtCod.Text, 11, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 12, 1)) >= "A" And UCase(Mid(txtCod.Text, 12, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
Else
If Mid(txtCod.Text, 1, 1) >= 0 And Mid(txtCod.Text, 1, 1) <= 9 Then
MsgBox "Les quattres premier caracteres doivent etre des lettres"
ElseIf Mid(txtCod.Text, 2, 1) >= 0 And Mid(txtCod.Text, 2, 1) <= 9 Then
MsgBox "Les quattres premier caracteres doivent etre des lettres"
ElseIf Mid(txtCod.Text, 3, 1) >= 0 And Mid(txtCod.Text, 3, 1) <= 9 Then
MsgBox "Les quattres premier caracteres doivent etre des lettres"
ElseIf Mid(txtCod.Text, 4, 1) >= 0 And Mid(txtCod.Text, 4, 1) <= 9 Then
MsgBox "Les quattres premier caracteres doivent etre des lettres"
Else
If iCod <= Month(Date) And iCod2 < Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1900 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >= Month(Date) And iCod2 > Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1901 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >Month(Date) And iCod2 Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1900 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >= Month(Date) Then
lblAge.Caption = Year(Date) - 1901 - iCod3 'La Date de Naissance
End If
If iCod2 >= 32 And iCod2 <= 60 Then
MsgBox "Un mois comporte que de 31 jours maximum"
ElseIf iCod2 > 60 And iCod2 <= 91 Then ' si le mois est plus de 60
lblJours.Caption = iCod2 - 60
ElseIf iCod2 > 91 Then 'si le mois est plus de 91 il n'existe pas
MsgBox "ERREUR Un mois comporte seulement 31 jours maximum"
Else
lblJours.Caption = iCod2
End If
lblIni.Caption = UCase(Mid(txtCod.Text, 4, 1)) ' Maj le 4ieme caractere
lblIni2.Caption = UCase(Mid(txtCod.Text, 1, 1)) ' Maj le Premier Caractere
If lblYear.Caption >= Year(Date) Then
MsgBox " La personne n'est pas encore née ou bien c'est un nouveau née"
End If
If lblAge.Caption >= 100 Then 'si l'age surpasse 100
lblAge.Caption = lblAge.Caption - 100
End If
End If
If Mid(txtCod.Text, 9, 1) >= 5 Then
lblYear.Caption = "19" + Mid(txtCod.Text, 9, 1) + Mid(txtCod.Text, 10, 1) 'Calcule L'annee
If lblYear.Caption Mod 4 And iCod = 2 Then 'Détermine une année non bissextile si le mois est février
lblBis.Caption = "En Février une année non bissextile comporte que de 28 jours"
ElseIf lblYear.Caption Mod 4 And iCod = 52 Then 'Détermine une année non bissextile si le mois est février
lblBis.Caption = "En Février une année non bissextile comporte que de 28 jours"
ElseIf iCod 2 And (lblYear.Caption Mod 100 Or ((lblYear.Caption Mod 400) 0)) Then 'Détermine une année bissextile si le mois est février
lblBis.Caption = "En Février une année Bissextile comporte que de 29 jours"
ElseIf iCod 52 And (lblYear.Caption Mod 100 Or ((lblYear.Caption Mod 400) 0)) Then 'Détermine une année bissextile si le mois est février
lblBis.Caption = "En Février une année Bissextile comporte que de 29 jours"
Else
lblBis.Caption = ""
End If
If iCod = "01" Then ' Le mois
lblMois.Caption = "Janvier"
ElseIf iCod = "02" Then ' Le mois
lblMois.Caption = "Février"
ElseIf iCod = "03" Then ' Le mois
lblMois.Caption = "Mars"
ElseIf iCod = "04" Then ' Le mois
lblMois.Caption = "Avril"
ElseIf iCod = "05" Then ' Le mois
lblMois.Caption = "Mai"
ElseIf iCod = "06" Then ' Le mois
lblMois.Caption = "Juin"
ElseIf iCod = "07" Then ' Le mois
lblMois.Caption = "Juillet"
ElseIf iCod = "08" Then ' Le mois
lblMois.Caption = "Août"
ElseIf iCod = "09" Then ' Le mois
lblMois.Caption = "Septembre"
ElseIf iCod = "10" Then ' Le mois
lblMois.Caption = "Octobre"
ElseIf iCod = "11" Then ' Le mois
lblMois.Caption = "Novembre"
ElseIf iCod = "12" Then ' Le mois
lblMois.Caption = "Décembre"
ElseIf iCod = "51" Then ' Le mois
lblMois.Caption = "Janvier"
ElseIf iCod = "52" Then ' Le mois
lblMois.Caption = "Février" 'Le mois
ElseIf iCod = "53" Then ' Le mois
lblMois.Caption = "Mars" 'Le mois
ElseIf iCod = "54" Then 'Le mois
lblMois.Caption = "Avril" 'Le mois
ElseIf iCod = "55" Then
lblMois.Caption = "Mai" ' Le mois
ElseIf iCod = "56" Then
lblMois.Caption = "Juin" 'Le mois
ElseIf iCod = "57" Then
lblMois.Caption = "Juillet" 'Le mois
ElseIf iCod = "58" Then
lblMois.Caption = "Août" 'Le mois
ElseIf iCod = "59" Then
lblMois.Caption = "septembre" 'Le mois
ElseIf iCod = "60" Then
lblMois.Caption = "Octobre" 'Le mois
ElseIf iCod = "61" Then
lblMois.Caption = "Novembre" 'Le mois
ElseIf iCod = "62" Then
lblMois.Caption = "Décembre" 'Le mois
Else
MsgBox "ERREUR le numéro du mois est invalide"
End If
If (Mid(txtCod.Text, 7, 2)) <= 12 Then ' Le sexe de la personne masculin
lblSexe.Caption = "Masculin"
ElseIf (Mid(txtCod.Text, 7, 2)) >= 51 And (Mid(txtCod.Text, 7, 2)) <= 62 Then ' Le sexe de la personne Féminin
lblSexe.Caption = "Féminin"
Else
End If
End If
End If
End Sub
.........
Tout commentaire me serait utile.
Et voici les lignes donc j'ai la difficulté -.-
If iCod <= Month(Date) And iCod2 < Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1900 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >= Month(Date) And iCod2 > Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1901 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >Month(Date) And iCod2 Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1900 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >= Month(Date) Then
lblAge.Caption = Year(Date) - 1901 - iCod3 'La Date de Naissance
End If
If lblYear.Caption >= Year(Date) Then
MsgBox " La personne n'est pas encore née ou bien c'est un nouveau née"
End If
If lblAge.Caption >= 100 Then 'si l'age surpasse 100
lblAge.Caption = lblAge.Caption - 100
End If
Je suis pas un génie et j'ai grandement besoin d'un coup de pouce.
Merci a tous
jaknight007
Messages postés17Date d'inscriptionmardi 8 mars 2005StatutMembreDernière intervention16 août 2014 4 juin 2009 à 19:30
Renfield et clad49 ont raisons, mais pour être plus précis, j'utilise :
Dim ageEntier As Integer
Dim ageDecimal As Double
'Trouver l'âge de la personne avec des décimale
ageDecimal = vDateReference.Subtract(vDateNaissance).Days / 365.25
'Supprimer les décimales
ageEntier = CType(Math.Floor(ageDecimal), Integer)
ageEntier nous donne la bonne réponse.
désolé, l'autre post contenait des date nullable (dim vDateReference as date? )
jaknight007
Messages postés17Date d'inscriptionmardi 8 mars 2005StatutMembreDernière intervention16 août 2014 4 juin 2009 à 19:28
Renfield et clad49 on raison, mais pour être plus précis, j'utilise :
Dim ageEntier As Integer
Dim ageDecimal As Double
'Trouver l'âge de la personne avec des décimale
ageDecimal = vDateReference.Value.Subtract(vDateNaissance.Value).Days / 365.25
'Supprimer les décimales
ageEntier = CType(Math.Floor(ageDecimal), Integer)
ageEntier nous donne la bonne réponse.
Streptococcus
Messages postés25Date d'inscriptionlundi 18 juin 2007StatutMembreDernière intervention18 juillet 2007 27 juin 2007 à 12:05
Bravo et merci Renfield...tu as tout bon
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 27 juin 2007 à 11:51
mon_age = age(08/09/1984)
8 divisé par 9 divisé par 1984 ...
Fais plutot :
mon_age = age(#9/8/1984#)
Streptococcus
Messages postés25Date d'inscriptionlundi 18 juin 2007StatutMembreDernière intervention18 juillet 2007 27 juin 2007 à 11:40
Alors après investigations complémentaires, et ayant utilisé la fonction de deux manières différentes :
Quand je fait :
Dim mon_age As Integer
mon_age = age(08/09/1984)
Dans ce cas, vu que l'on est en 2007, j'obtient un age de 107, car dans la fonction, la date doit être transformée en 01/01/1900...je suis sous VB6, donc j'ai un mode débug un peu primaire qui permet néanmoins de voir la valeur des variables, et donc en mode pas à pas, quand je suis dans la fonction et que je passe ma souris sur la variable DateNaissance, je ne lis que 00:00:15 ou quelques chose dans le genre.
Par contre j'ai utilisé la fonction comme suit :
Dim un_age As Integer
un_age = age(rst(date_naissance)), où rst est le résultat d'une requête SQL d'un champ date.
Et là ça à l'air de marcher parfaitement.
Donc d'après ce que je comprend, la fonction telle qu'elle est écrite dans mon précédent post reconnait le format date de ma bdd (SmallDateTime sous SQL Server), par contre il ne reconnait pas un format rentré en dur du type jj/mm/aaaa...
J'aimerais juste comprendre pourquoi...mais bon, l'un dans l'autre, la fonction à l'air de marcher pour ce que je veux en faire, donc si ce que je viens de te raconter n'est absolument pas clair...batailles pas.
Merci en tout cas
Quentin
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 27 juin 2007 à 11:03
une date est une date...
que transmets tu, exactement ?
Streptococcus
Messages postés25Date d'inscriptionlundi 18 juin 2007StatutMembreDernière intervention18 juillet 2007 27 juin 2007 à 10:42
La solution de Renfiel est simple et efficace, mon seul problème avec elle, c'est que quand, ayant déclaré une fonction du type :
Public Function age(DateNaissance As Date) As Integer
age = Int(DateDiff("d", DateNaissance, Date) / 365.25)
End Function
je passe en paramètre DateNaissance une date du type jj/mm/aaaa, j'obtiens systématiquement un age de 107 ans. En fait en passant la fonction au débugger, je m'aperçois qu'il transforme DateNaissance en une heure (00:00:00) donc à chaque fois il me calcule un age pour une date de naissance du 01/01/1900...
Est-ce que quelqu'un saurait comment résoudre ce facheux problème ?
Merci d'avance
Quentin
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 12 avril 2007 à 14:43
Clad49, ton code n'est pas précis...
en VB6 :
Age = val(datediff("D", DateNaissance, DateJour)/365.25)
nerazzurro01
Messages postés41Date d'inscriptionjeudi 12 avril 2007StatutMembreDernière intervention14 janvier 2008 12 avril 2007 à 13:43
bonjour je chercher dont j 'ai besion
g deux champs de datime piker et je veux calculer la date diffence entre les deux mais ca marche
j'aimerai bien avoir code qui marche de votre part
c urgent
merci
Clad49
Messages postés265Date d'inscriptiondimanche 3 août 2003StatutMembreDernière intervention29 mars 2010 21 janv. 2007 à 22:31
Salut
Essayez ca :
Private Function Age(ByVal vDate As String) As Integer
age = Math.Floor(DateDiff(Microsoft.VisualBasic.DateInterval.Month, CDate(vDate), Today, ) / 12)
End Function
et pour l'appeler :
MsgBox(Age("11/05/1985"))
bonne prog ;)
Clad
avrillavigne1
Messages postés2Date d'inscriptiondimanche 9 avril 2006StatutMembreDernière intervention 2 octobre 2006 2 oct. 2006 à 18:38
merci pour le code
wan186
Messages postés2Date d'inscriptionmardi 9 août 2005StatutMembreDernière intervention11 août 2006 11 août 2006 à 16:10
Voilà le mix des deux... exact et sans utilisation de cast!
Dim age As Integer = DateDiff(DateInterval.Year, NaissDacDateTimePicker.Value, DateTime.Now)
If Today.Month > NaissDacDateTimePicker.Value.Month Or Today.Month = NaissDacDateTimePicker.Value.Month AndAlso Today.Day >= NaissDacDateTimePicker.Value.Day Then
age += 1
End If
wan186
Messages postés2Date d'inscriptionmardi 9 août 2005StatutMembreDernière intervention11 août 2006 11 août 2006 à 15:59
Olixelle: Il y a un prob avec DateDiff: il ne tient pas compte du mois et du jour. Si on est en Octobre 2006 et que la date de naissance est Novembre 2000, alors il donne un age de 6 ans... au lieu de 5.
Donc vive IO_OST ;-)
io_ost
Messages postés151Date d'inscriptionmercredi 1 février 2006StatutMembreDernière intervention 6 février 2009 1 août 2006 à 12:21
pas mal olixelle je test .... et j'essaye de rajouter le nombre de mois et de jours ...
olixelle
Messages postés506Date d'inscriptionvendredi 30 juillet 2004StatutMembreDernière intervention 3 mars 20082 28 juil. 2006 à 16:20
en plus simple:
_______________________________________________________________________________
Protected Sub calcul_age()
Dim datedenaissance = CDate(TbDn.Text)
Dim age As Integer = DateDiff(DateInterval.Year, DateTime.Now, datedenaissance)
Me.Label3.Text = " Age : " & age & " ans"
End Sub
__________________________________________________________________________________
io_ost
Messages postés151Date d'inscriptionmercredi 1 février 2006StatutMembreDernière intervention 6 février 2009 28 juil. 2006 à 08:59
désolé j'avais changer le nom des strings avant le post pour la présentation ! ^^
ciao bon dev....
dvdstory
Messages postés192Date d'inscriptiondimanche 23 janvier 2005StatutMembreDernière intervention10 août 2009 28 juil. 2006 à 07:42
erreur, ta mis str3 a la place de str2 et j'ai rajouté la ligne de code pour afficher la résultat que t'avais mis dans code original pas dans le le post.
Protected Sub calculage()
Dim str As String = "26/01/1977"
Dim datetimenow = DateTime.Now
Dim datedenaissance = CDate(str)
Dim age As Integer
Dim str2 As String
age = CInt(Now.Year - datedenaissance.Year)
str2 = " Age : " & age & " ans"
If (datedenaissance.Month > Now.Month) Then
age = age - 1
str2 = " Age : " & age & " ans"
End If
If ((datedenaissance.Month = Now.Month) And (datedenaissance.Day > Now.Day)) Then
age = age - 1
str2 = " Age : " & age & " ans"
End If
Me.Label1.Text = " Age : " & age & " ans" 'Affiche dans un label
End Sub
io_ost
Messages postés151Date d'inscriptionmercredi 1 février 2006StatutMembreDernière intervention 6 février 2009 27 juil. 2006 à 22:41
Protected Sub calculage()
Dim str As String = "26/01/1977"
Dim datetimenow = DateTime.Now
Dim datedenaissance = CDate(str)
Dim age As Integer
Dim str2 As String
age = CInt(Now.Year - datedenaissance.Year)
str3 = " Age : " & age & " ans"
If (datedenaissance.Month > Now.Month) Then
age = age - 1
str2 = " Age : " & age & " ans"
End If
If ((datedenaissance.Month = Now.Month) And (datedenaissance.Day > Now.Day)) Then
age = age - 1
str2 = " Age : " & age & " ans"
End If
End Sub
tu est tombé amoureux de ma sub bidou ?
cs_Bidou
Messages postés5487Date d'inscriptiondimanche 4 août 2002StatutMembreDernière intervention20 juin 201361 27 juil. 2006 à 20:57
Je pense qu'un snippet sur codyx aurait suffit, m'enfin!
dvdstory
Messages postés192Date d'inscriptiondimanche 23 janvier 2005StatutMembreDernière intervention10 août 2009 26 juil. 2006 à 15:42
Bonjour
J'ai un pb à la ligne de code ci-dessous.
Dim datedenaissance = CDate(TbDn.Text)
Le debbugger me dit que "La conversion de la chaîne en type 'Date' n'est pas valide."
Pourriez vous me donner la bonne syntaxe pour la date SVP.
Merci d'avance
io_ost
Messages postés151Date d'inscriptionmercredi 1 février 2006StatutMembreDernière intervention 6 février 2009 20 juil. 2006 à 11:12
ça calcul l'âge !! j'avais pas promis la lune ^^ (niveau débutant) je suis sûr que ça peu servir à quelqu'un (moi ça m'aurais fais gagner du temps)
cs_Bidou
Messages postés5487Date d'inscriptiondimanche 4 août 2002StatutMembreDernière intervention20 juin 201361 20 juil. 2006 à 10:36
C'est effectivement assez léger comme code source...
8 juin 2010 à 17:43
If DateSerial(Year(Date), Month(DateNaissance), Day(DateNaissance)) > Date Then
MyAge = Year(Date) - Year(DateNaissance) - 1
Else
MyAge = Year(Date) - Year(DateNaissance)
End if
4 févr. 2010 à 16:18
4 févr. 2010 à 16:04
(Nombre de jours entre naissance et date du jour )
???
euh, ben, c'est ...
le nombre de jour entre :
- date de naissance
- date courante
4 févr. 2010 à 16:00
4 févr. 2010 à 15:59
(Nombre de jours entre naissance et date du jour )
Je crois que cela ma m'aide beacoup
4 févr. 2010 à 15:58
Private Sub cmdAff_Click()
Dim nDay As Integer
Dim nMonth As Integer
Dim nYear As Integer
Dim bBirth As Date
If Len(txtCod.Text) <> 12 Then
MsgBox "Veuillez entrer votre code permanent", vbExclamation
ElseIf Not txtCod.Text Like "*[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres", vbExclamation
ElseIf Not txtCod.Text Like "[A-Z][A-Z][A-Z][A-Z]*" Then
MsgBox "Les quatres premier caracteres doivent etre des lettres", vbExclamation
Else
nDay = Val(Mid$(txtCod.Text, 5, 2))
nMonth = Val(Mid$(txtCod.Text, 7, 2))
nYear = Val(Mid$(txtCod.Text, 9, 2))
dBirth = DateSerial(nYear, nMonth, nDay)
lblMois.Caption = MonthName(nMonth)
If nMonth <= 12 Then
lblSexe.Caption = "Masculin"
Else
lblSexe.Caption = "Féminin"
End If
lblAge.Caption = CLng((Date - dBirth) / 365.25)
End If
End Sub
4 févr. 2010 à 15:46
Age = (Nombre de jours entre naissance et date du jour ) / 365.25
4 févr. 2010 à 15:20
Je doit finir mon programme d'ici une semaine qui constitue a trouver la date de naissance, l'âge et le sexe de la personne juste en sachant son code permanent. Voici mon code et voici mon problème je suis incapable de trouver l'age .
Option Explicit
Private Sub cmdAff_Click()
Dim iCod As String
Dim iCod2 As String
Dim iCod3 As String
Let iCod = Mid(txtCod.Text, 7, 2) ' Numérise le mois
Let iCod2 = Mid(txtCod.Text, 5, 2) 'Numérise le jours
Let iCod3 = Mid(txtCod.Text, 9, 2) 'Numérise l'annee
If txtCod.Text = "" Then
MsgBox "Veuillez entrer votre code permanent"
Else
If UCase(Mid(txtCod.Text, 5, 1)) >= "A" And UCase(Mid(txtCod.Text, 5, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 6, 1)) >= "A" And UCase(Mid(txtCod.Text, 6, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 7, 1)) >= "A" And UCase(Mid(txtCod.Text, 7, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 8, 1)) >= "A" And UCase(Mid(txtCod.Text, 8, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 9, 1)) >= "A" And UCase(Mid(txtCod.Text, 9, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 10, 1)) >= "A" And UCase(Mid(txtCod.Text, 10, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 11, 1)) >= "A" And UCase(Mid(txtCod.Text, 11, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
ElseIf UCase(Mid(txtCod.Text, 12, 1)) >= "A" And UCase(Mid(txtCod.Text, 12, 1)) <= "Z" Then
MsgBox "Les Huits dernier caractere doivent etre des chiffres"
Else
If Mid(txtCod.Text, 1, 1) >= 0 And Mid(txtCod.Text, 1, 1) <= 9 Then
MsgBox "Les quattres premier caracteres doivent etre des lettres"
ElseIf Mid(txtCod.Text, 2, 1) >= 0 And Mid(txtCod.Text, 2, 1) <= 9 Then
MsgBox "Les quattres premier caracteres doivent etre des lettres"
ElseIf Mid(txtCod.Text, 3, 1) >= 0 And Mid(txtCod.Text, 3, 1) <= 9 Then
MsgBox "Les quattres premier caracteres doivent etre des lettres"
ElseIf Mid(txtCod.Text, 4, 1) >= 0 And Mid(txtCod.Text, 4, 1) <= 9 Then
MsgBox "Les quattres premier caracteres doivent etre des lettres"
Else
If iCod <= Month(Date) And iCod2 < Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1900 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >= Month(Date) And iCod2 > Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1901 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >Month(Date) And iCod2 Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1900 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >= Month(Date) Then
lblAge.Caption = Year(Date) - 1901 - iCod3 'La Date de Naissance
End If
If iCod2 >= 32 And iCod2 <= 60 Then
MsgBox "Un mois comporte que de 31 jours maximum"
ElseIf iCod2 > 60 And iCod2 <= 91 Then ' si le mois est plus de 60
lblJours.Caption = iCod2 - 60
ElseIf iCod2 > 91 Then 'si le mois est plus de 91 il n'existe pas
MsgBox "ERREUR Un mois comporte seulement 31 jours maximum"
Else
lblJours.Caption = iCod2
End If
lblIni.Caption = UCase(Mid(txtCod.Text, 4, 1)) ' Maj le 4ieme caractere
lblIni2.Caption = UCase(Mid(txtCod.Text, 1, 1)) ' Maj le Premier Caractere
If lblYear.Caption >= Year(Date) Then
MsgBox " La personne n'est pas encore née ou bien c'est un nouveau née"
End If
If lblAge.Caption >= 100 Then 'si l'age surpasse 100
lblAge.Caption = lblAge.Caption - 100
End If
End If
If Mid(txtCod.Text, 9, 1) >= 5 Then
lblYear.Caption = "19" + Mid(txtCod.Text, 9, 1) + Mid(txtCod.Text, 10, 1) 'Calcule L'annee
ElseIf Mid(txtCod.Text, 9, 1) <= 4 Then
lblYear.Caption = "20" + Mid(txtCod.Text, 9, 1) + Mid(txtCod.Text, 10, 1) 'Calcule L'annee
Else
MsgBox "ERREUR NON VALIDE"
End If
If lblYear.Caption Mod 4 And iCod = 2 Then 'Détermine une année non bissextile si le mois est février
lblBis.Caption = "En Février une année non bissextile comporte que de 28 jours"
ElseIf lblYear.Caption Mod 4 And iCod = 52 Then 'Détermine une année non bissextile si le mois est février
lblBis.Caption = "En Février une année non bissextile comporte que de 28 jours"
ElseIf iCod 2 And (lblYear.Caption Mod 100 Or ((lblYear.Caption Mod 400) 0)) Then 'Détermine une année bissextile si le mois est février
lblBis.Caption = "En Février une année Bissextile comporte que de 29 jours"
ElseIf iCod 52 And (lblYear.Caption Mod 100 Or ((lblYear.Caption Mod 400) 0)) Then 'Détermine une année bissextile si le mois est février
lblBis.Caption = "En Février une année Bissextile comporte que de 29 jours"
Else
lblBis.Caption = ""
End If
If iCod = "01" Then ' Le mois
lblMois.Caption = "Janvier"
ElseIf iCod = "02" Then ' Le mois
lblMois.Caption = "Février"
ElseIf iCod = "03" Then ' Le mois
lblMois.Caption = "Mars"
ElseIf iCod = "04" Then ' Le mois
lblMois.Caption = "Avril"
ElseIf iCod = "05" Then ' Le mois
lblMois.Caption = "Mai"
ElseIf iCod = "06" Then ' Le mois
lblMois.Caption = "Juin"
ElseIf iCod = "07" Then ' Le mois
lblMois.Caption = "Juillet"
ElseIf iCod = "08" Then ' Le mois
lblMois.Caption = "Août"
ElseIf iCod = "09" Then ' Le mois
lblMois.Caption = "Septembre"
ElseIf iCod = "10" Then ' Le mois
lblMois.Caption = "Octobre"
ElseIf iCod = "11" Then ' Le mois
lblMois.Caption = "Novembre"
ElseIf iCod = "12" Then ' Le mois
lblMois.Caption = "Décembre"
ElseIf iCod = "51" Then ' Le mois
lblMois.Caption = "Janvier"
ElseIf iCod = "52" Then ' Le mois
lblMois.Caption = "Février" 'Le mois
ElseIf iCod = "53" Then ' Le mois
lblMois.Caption = "Mars" 'Le mois
ElseIf iCod = "54" Then 'Le mois
lblMois.Caption = "Avril" 'Le mois
ElseIf iCod = "55" Then
lblMois.Caption = "Mai" ' Le mois
ElseIf iCod = "56" Then
lblMois.Caption = "Juin" 'Le mois
ElseIf iCod = "57" Then
lblMois.Caption = "Juillet" 'Le mois
ElseIf iCod = "58" Then
lblMois.Caption = "Août" 'Le mois
ElseIf iCod = "59" Then
lblMois.Caption = "septembre" 'Le mois
ElseIf iCod = "60" Then
lblMois.Caption = "Octobre" 'Le mois
ElseIf iCod = "61" Then
lblMois.Caption = "Novembre" 'Le mois
ElseIf iCod = "62" Then
lblMois.Caption = "Décembre" 'Le mois
Else
MsgBox "ERREUR le numéro du mois est invalide"
End If
If (Mid(txtCod.Text, 7, 2)) <= 12 Then ' Le sexe de la personne masculin
lblSexe.Caption = "Masculin"
ElseIf (Mid(txtCod.Text, 7, 2)) >= 51 And (Mid(txtCod.Text, 7, 2)) <= 62 Then ' Le sexe de la personne Féminin
lblSexe.Caption = "Féminin"
Else
End If
End If
End If
End Sub
.........
Tout commentaire me serait utile.
Et voici les lignes donc j'ai la difficulté -.-
If iCod <= Month(Date) And iCod2 < Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1900 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >= Month(Date) And iCod2 > Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1901 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >Month(Date) And iCod2 Day(Date) Then 'La Date de Naissance
lblAge.Caption = Year(Date) - 1900 - iCod3
ElseIf Mid(txtCod.Text, 7, 2) >= Month(Date) Then
lblAge.Caption = Year(Date) - 1901 - iCod3 'La Date de Naissance
End If
If lblYear.Caption >= Year(Date) Then
MsgBox " La personne n'est pas encore née ou bien c'est un nouveau née"
End If
If lblAge.Caption >= 100 Then 'si l'age surpasse 100
lblAge.Caption = lblAge.Caption - 100
End If
Je suis pas un génie et j'ai grandement besoin d'un coup de pouce.
Merci a tous
4 juin 2009 à 19:30
Dim ageEntier As Integer
Dim ageDecimal As Double
'Trouver l'âge de la personne avec des décimale
ageDecimal = vDateReference.Subtract(vDateNaissance).Days / 365.25
'Supprimer les décimales
ageEntier = CType(Math.Floor(ageDecimal), Integer)
ageEntier nous donne la bonne réponse.
désolé, l'autre post contenait des date nullable (dim vDateReference as date? )
4 juin 2009 à 19:28
Dim ageEntier As Integer
Dim ageDecimal As Double
'Trouver l'âge de la personne avec des décimale
ageDecimal = vDateReference.Value.Subtract(vDateNaissance.Value).Days / 365.25
'Supprimer les décimales
ageEntier = CType(Math.Floor(ageDecimal), Integer)
ageEntier nous donne la bonne réponse.
27 juin 2007 à 12:05
27 juin 2007 à 11:51
8 divisé par 9 divisé par 1984 ...
Fais plutot :
mon_age = age(#9/8/1984#)
27 juin 2007 à 11:40
Quand je fait :
Dim mon_age As Integer
mon_age = age(08/09/1984)
Dans ce cas, vu que l'on est en 2007, j'obtient un age de 107, car dans la fonction, la date doit être transformée en 01/01/1900...je suis sous VB6, donc j'ai un mode débug un peu primaire qui permet néanmoins de voir la valeur des variables, et donc en mode pas à pas, quand je suis dans la fonction et que je passe ma souris sur la variable DateNaissance, je ne lis que 00:00:15 ou quelques chose dans le genre.
Par contre j'ai utilisé la fonction comme suit :
Dim un_age As Integer
un_age = age(rst(date_naissance)), où rst est le résultat d'une requête SQL d'un champ date.
Et là ça à l'air de marcher parfaitement.
Donc d'après ce que je comprend, la fonction telle qu'elle est écrite dans mon précédent post reconnait le format date de ma bdd (SmallDateTime sous SQL Server), par contre il ne reconnait pas un format rentré en dur du type jj/mm/aaaa...
J'aimerais juste comprendre pourquoi...mais bon, l'un dans l'autre, la fonction à l'air de marcher pour ce que je veux en faire, donc si ce que je viens de te raconter n'est absolument pas clair...batailles pas.
Merci en tout cas
Quentin
27 juin 2007 à 11:03
que transmets tu, exactement ?
27 juin 2007 à 10:42
Public Function age(DateNaissance As Date) As Integer
age = Int(DateDiff("d", DateNaissance, Date) / 365.25)
End Function
je passe en paramètre DateNaissance une date du type jj/mm/aaaa, j'obtiens systématiquement un age de 107 ans. En fait en passant la fonction au débugger, je m'aperçois qu'il transforme DateNaissance en une heure (00:00:00) donc à chaque fois il me calcule un age pour une date de naissance du 01/01/1900...
Est-ce que quelqu'un saurait comment résoudre ce facheux problème ?
Merci d'avance
Quentin
12 avril 2007 à 14:43
en VB6 :
Age = val(datediff("D", DateNaissance, DateJour)/365.25)
12 avril 2007 à 13:43
g deux champs de datime piker et je veux calculer la date diffence entre les deux mais ca marche
j'aimerai bien avoir code qui marche de votre part
c urgent
merci
21 janv. 2007 à 22:31
Essayez ca :
Private Function Age(ByVal vDate As String) As Integer
age = Math.Floor(DateDiff(Microsoft.VisualBasic.DateInterval.Month, CDate(vDate), Today, ) / 12)
End Function
et pour l'appeler :
MsgBox(Age("11/05/1985"))
bonne prog ;)
Clad
2 oct. 2006 à 18:38
11 août 2006 à 16:10
Dim age As Integer = DateDiff(DateInterval.Year, NaissDacDateTimePicker.Value, DateTime.Now)
If Today.Month > NaissDacDateTimePicker.Value.Month Or Today.Month = NaissDacDateTimePicker.Value.Month AndAlso Today.Day >= NaissDacDateTimePicker.Value.Day Then
age += 1
End If
11 août 2006 à 15:59
Donc vive IO_OST ;-)
1 août 2006 à 12:21
28 juil. 2006 à 16:20
_______________________________________________________________________________
Protected Sub calcul_age()
Dim datedenaissance = CDate(TbDn.Text)
Dim age As Integer = DateDiff(DateInterval.Year, DateTime.Now, datedenaissance)
Me.Label3.Text = " Age : " & age & " ans"
End Sub
__________________________________________________________________________________
28 juil. 2006 à 08:59
ciao bon dev....
28 juil. 2006 à 07:42
Protected Sub calculage()
Dim str As String = "26/01/1977"
Dim datetimenow = DateTime.Now
Dim datedenaissance = CDate(str)
Dim age As Integer
Dim str2 As String
age = CInt(Now.Year - datedenaissance.Year)
str2 = " Age : " & age & " ans"
If (datedenaissance.Month > Now.Month) Then
age = age - 1
str2 = " Age : " & age & " ans"
End If
If ((datedenaissance.Month = Now.Month) And (datedenaissance.Day > Now.Day)) Then
age = age - 1
str2 = " Age : " & age & " ans"
End If
Me.Label1.Text = " Age : " & age & " ans" 'Affiche dans un label
End Sub
27 juil. 2006 à 22:41
Dim str As String = "26/01/1977"
Dim datetimenow = DateTime.Now
Dim datedenaissance = CDate(str)
Dim age As Integer
Dim str2 As String
age = CInt(Now.Year - datedenaissance.Year)
str3 = " Age : " & age & " ans"
If (datedenaissance.Month > Now.Month) Then
age = age - 1
str2 = " Age : " & age & " ans"
End If
If ((datedenaissance.Month = Now.Month) And (datedenaissance.Day > Now.Day)) Then
age = age - 1
str2 = " Age : " & age & " ans"
End If
End Sub
tu est tombé amoureux de ma sub bidou ?
27 juil. 2006 à 20:57
26 juil. 2006 à 15:42
J'ai un pb à la ligne de code ci-dessous.
Dim datedenaissance = CDate(TbDn.Text)
Le debbugger me dit que "La conversion de la chaîne en type 'Date' n'est pas valide."
Pourriez vous me donner la bonne syntaxe pour la date SVP.
Merci d'avance
20 juil. 2006 à 11:12
20 juil. 2006 à 10:36