Accueil – Le CFO masqué › Forums › VBA › Calculer l’âge précis d’une personne
- Ce sujet contient 10 réponses, 2 participants et a été mis à jour pour la dernière fois par Pimpin, le il y a 4 années et 3 mois.
-
AuteurArticles
-
30 juillet 2020 à 1 h 29 min #72807PimpinParticipant
Bonjour,
A partir d’une date valide saisie (JJ/MM/AAAA) dans une TEXTBOX, je voudrais calculer l’âge précis d’une personne. Exemple :
Date de naissance : 15/03/2000
Vous avez : 20 ans 4 mois et 15 jours.Bien sûr on affiche pas le mois ou le jours, s’ils sont égalent à 0.
Date de naissance : 15/07/2000
Vous avez : 20 ans 0 mois et 15 jours (non).
Vous avez : 20 ans et 15 jours (oui).Et si c’est la date d’anniversaire :
Date de naissance : 30/07/2000
Vous avez : 20 ans 0 mois et 0 jours (non).
Vous avez : 20 ans aujourd’hui, JOYEUX ANNIVERSAIRE (oui).Merci pour votre aide.
31 juillet 2020 à 17 h 04 min #73170LionelParticipantSalut Pimpin,
Voici ce que je te propose :Sub DateNaiss() Dim NbAns As Long, NbMois As Long, NbJours As Long Dim Tmp As Date, sA As String, sM As String, sJ As String DateDebut = "Ce n'est pas une date !" While Not IsDate(DateDebut) DateDebut = InputBox("Entrez une date", "Date", DateDebut) Wend DateFin = Now() Tmp = DateSerial(Year(DateFin), Month(DateDebut), Day(DateDebut)) NbAns = Year(DateFin) - Year(DateDebut) + (Tmp > DateFin) NbMois = Month(DateFin) - Month(DateDebut) - (12 * (Tmp > DateFin)) NbJours = Day(DateFin) - Day(DateDebut) If NbJours < 0 Then NbMois = NbMois - 1 NbJours = Day(DateSerial(Year(DateFin), Month(DateFin), 0)) + NbJours End If If NbAns = 0 Then sA = "" Else _ If NbAns = 1 Then sA = NbAns & " an " Else sA = NbAns & " ans " If NbMois = 0 Then sM = "" Else sM = NbMois & " mois " If NbJours = 0 Then sJ = "" Else If NbJours = 1 Then sJ = NbJours & " jour" Else sJ = NbJours & " jours" If NbMois = 0 And NbJours = 0 Then DiffDateAMJ = "Vous avez : " & Trim$(sA) & " aujourd'hui, JOYEUX ANNIVERSAIRE" Else: DiffDateAMJ = "Vous avez : " & Trim$(sA & sM & sJ) End If MsgBox DiffDateAMJ End Sub
NB : je reviens vers toi dans quelques jours pour l’hôtel. 😉
1 août 2020 à 14 h 07 min #73663PimpinParticipantSalut mon ami,
Tu es trop fort, je n’ai pas encore tester ton programme.
Mais je suis sûr que cela fonctionne vu la façon dont s’est écrit.
Je te remercie donc sincèrement.1 août 2020 à 14 h 53 min #73664PimpinParticipantOups !
J’ai dû déclarer les variables :
Dim DateDebut As String
Dim DateFin As Date
Dim DiffDateAMJ As stringSinon lorsque je clique sur “Annuler” je reste dans la boucle tant que je ne rentre pas une date.
Et surtout la date ne respecte pas le format JJ/MM/YYYY.
Si je rentre 15/8/2010 ou 8/15/2010 ça me donne le même résultat.
Mais sinon il est pas mal ton programme.3 août 2020 à 5 h 29 min #73685LionelParticipantTu ajoutes ceci
... While Not IsDate(DateDebut) DateDebut = InputBox("Entrez une date", "Date", DateDebut) <strong>If DateDebut = "" Then Exit Sub</strong> Wend ...
3 août 2020 à 12 h 12 min #73790PimpinParticipantSalut mon ami,
Quand je rajoute cette ligne comme tu m’as dit :
If DateDebut = “” Then Exit Sub
Cela me donne l’erreur suivante :
Erreur de compilation
Erreur de syntaxe
Attendu : numéro de ligne ou étiquette ou instruction ou fin d’instruction.Sinon pour la date je veux la saisir dans une textbox (txt_datenaissance) et non dans une inputbox.
Mais cela ne change rien au résultat. Aucun des 2 ne tient compte du format demandé :
Je veux ce format “DD/MM/YYYY”
et il me fait à sa tête “MM/DD/YYYY”.
Sauf si je rentre une date ainsi 2/13/1988 il change en mettant 13/02/1988.
Mais si je tape le 3/9/88 il me le change en 09/03/1988 ????.
De plus quand je vérifie dans l’écriture dans le fichier il me met 9/3/1988 au lieu de 09/03/1988.
Je suis obligé de le faire manuellement.Merci pour ton aide.
3 août 2020 à 14 h 48 min #73846LionelParticipantSi tu veux forcer voici un autre code. J’ai créé vite fait un UserForm1 avec un TextBox1.
Private Sub CommandButton1_Click() DateDebut = TextBox1.Value DateFin = Now() Tmp = DateSerial(Year(DateFin), Month(DateDebut), Day(DateDebut)) NbAns = Year(DateFin) - Year(DateDebut) + (Tmp > DateFin) NbMois = Month(DateFin) - Month(DateDebut) - (12 * (Tmp > DateFin)) NbJours = Day(DateFin) - Day(DateDebut) If NbJours < 0 Then NbMois = NbMois - 1 NbJours = Day(DateSerial(Year(DateFin), Month(DateFin), 0)) + NbJours End If If NbAns = 0 Then sA = "" Else _ If NbAns = 1 Then sA = NbAns & " an " Else sA = NbAns & " ans " If NbMois = 0 Then sM = "" Else sM = NbMois & " mois " If NbJours = 0 Then sJ = "" Else If NbJours = 1 Then sJ = NbJours & " jour" Else sJ = NbJours & " jours" If NbMois = 0 And NbJours = 0 Then DiffDateAMJ = "Vous avez : " & Trim$(sA) & " aujourd'hui, JOYEUX ANNIVERSAIRE" Else DiffDateAMJ = "Vous avez : " & Trim$(sA & sM & sJ) End If MsgBox DiffDateAMJ Unload UserForm1 End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 8 Then If Right(TextBox1, 1) = "/" Then TextBox1 = Mid(TextBox1, 1, Len(TextBox1) - 1) ElseIf KeyCode = 46 Then TextBox1 = "" End If End Sub Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode < 96 Or KeyCode > 105 Then If TextBox1 <> "" Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1) End If Select Case Len(TextBox1.Text) Case 2: If Val(TextBox1.Value) > 31 Then TextBox1.Value = "": MsgBox "jour trop grand" Else TextBox1 = TextBox1 & "/" Case 5: If Mid(TextBox1, 4, 2) > 12 Then TextBox1.Value = Mid(TextBox1, 1, 3): MsgBox "mois trop grand" Else TextBox1 = TextBox1 & "/" Case 10: If Not IsDate(TextBox1) Then MsgBox "tu veux une claque ou quoi?" & vbCrLf & " Ou ta vu que ce jour existe dans le calendrier" & vbCrLf & " allez recommence!!!": TextBox1 = "" Case 11: TextBox1 = Mid(TextBox1, 1, 10) End Select End Sub
4 août 2020 à 11 h 26 min #73929PimpinParticipantMerci mon ami,
Je vais le tester et je te tiens au jus !
Passe une bonne soirée
4 août 2020 à 12 h 38 min #73945PimpinParticipantIl est pas mal ton programme. J’ai remarqué que tu contrôles bien le jour et le mois. Mais je voudrais aussi
forcer l’année à 4 chiffres ça évitera des erreurs aussi. Et je veux que l’année autorisée soit comprise entre :
now-120 ans <= année autorisée < now.
Oui je sais que je suis pointilleux lol…
Sinon est-ce que j’ai été clair dans ma requête ?5 août 2020 à 10 h 20 min #74458LionelParticipantUne nouvelle épreuve :
Private Sub CommandButton1_Click() DateDebut = TextBox1.Value DateFin = Now() Tmp = DateSerial(Year(DateFin), Month(DateDebut), Day(DateDebut)) NbAns = Year(DateFin) - Year(DateDebut) + (Tmp > DateFin) NbMois = Month(DateFin) - Month(DateDebut) - (12 * (Tmp > DateFin)) NbJours = Day(DateFin) - Day(DateDebut) If NbJours < 0 Then NbMois = NbMois - 1 NbJours = Day(DateSerial(Year(DateFin), Month(DateFin), 0)) + NbJours End If If NbAns = 0 Then sA = "" Else _ If NbAns = 1 Then sA = NbAns & " an " Else sA = NbAns & " ans " If NbMois = 0 Then sM = "" Else sM = NbMois & " mois " If NbJours = 0 Then sJ = "" Else If NbJours = 1 Then sJ = NbJours & " jour" Else sJ = NbJours & " jours" If NbMois = 0 And NbJours = 0 Then DiffDateAMJ = "Vous avez : " & Trim$(sA) & " aujourd'hui, JOYEUX ANNIVERSAIRE" Else DiffDateAMJ = "Vous avez : " & Trim$(sA & sM & sJ) End If MsgBox DiffDateAMJ Unload UserForm1 End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 8 Then If Right(TextBox1, 1) = "/" Then TextBox1 = Mid(TextBox1, 1, Len(TextBox1) - 1) ElseIf KeyCode = 46 Then TextBox1 = "" End If End Sub Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode < 96 Or KeyCode > 105 Then If TextBox1 <> "" Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1) End If Select Case Len(TextBox1.Text) Case 2: If Val(TextBox1.Value) > 31 Then TextBox1.Value = "": MsgBox "Jour trop grand" Else TextBox1 = TextBox1 & "/" Case 5: If Mid(TextBox1, 4, 2) > 12 Then TextBox1.Value = Mid(TextBox1, 1, 3): MsgBox "Mois trop grand" Else TextBox1 = TextBox1 & "/" Case 10: If Not IsDate(TextBox1) Or Val(Mid(TextBox1, 7, 4)) < Val(Mid(Now(), 7, 4)) - 120 Or CDate(TextBox1) > Now() - 1 _ Then MsgBox "N'importe quoi !" & vbCrLf & "Allez recommence!!!": TextBox1 = "" Case Is > 10: TextBox1 = Mid(TextBox1, 1, 10) End Select End Sub
5 août 2020 à 14 h 20 min #74752PimpinParticipantMerci mon ami,
Je pense qu’il sera bon ton programme.
Je vais regarder tout ça à tête reposée ce week-end.
Merci encore.
@+ -
AuteurArticles
- Vous devez être connecté pour répondre à ce sujet.