[VBA]Calculé age d 'une personne au jour près

[oxydedefer]

Bonjour , je souhaite avoir l'age en année d une personne , cette age dois changé si c'est le jour de son anniversaire ,et dois prendre en compte les année bissextile . J'ai déjà trouver une bonne formule , le soucis c'est lorsque je l'incorpore à mon programme vba il me met un age de

ActiveCell.FormulaR1C1 = "=DATEDIF(RC[-1],TODAY(),""y"")"

voici mon code au complet:

Dim numLigneVide As Long
Dim agepersonne As Integer

Worksheets("Liste de la clientel").Activate
  'On trouve la dernière ligne vide du tableau et on enregistre le numéro de la ligne dans la variable
  numLigneVide = Range("A" & Rows.Count).End(xlUp).Row
 ' With "Liste de la clientel"
  
        If TextNom.Text = "" Then
        MsgBox "Veuillez remplir le nom de votre contact", vbCritical, "Champs manquant"
        TextNom.SetFocus
        ElseIf Textprenom.Text = "" Then
        MsgBox "Veuillez remplir le prénom de votre contact", vbCritical, "Champs manquant"
        Textprenom.SetFocus
        ElseIf IsNumeric(TextNom.Text) Then
         MsgBox "Le nom ne dois pas comporter de chiffres", vbCritical, "Champs manquant"
        TextNom.SetFocus
         ElseIf IsNumeric(Textprenom.Text) Then
         MsgBox "Le prénom ne dois pas comporter de chiffres", vbCritical, "Champs manquant"
        TextNom.SetFocus
        
        Else
        'On remplit les données dans notre tableau
        ActiveSheet.Cells(numLigneVide, 1) = TextNom.Text
        ActiveSheet.Cells(numLigneVide, 2) = Textprenom.Text
        ActiveSheet.Cells(numLigneVide, 3) = DateText.Text
         
    agepersonne = ActiveCell.FormulaR1C1 = DATEDIF(c1, Today(), "y")
   
        
         ActiveSheet.Cells(numLigneVide, 4) = agepersonne
        'On efface le formulaire et on replace le curseur sur le premier champs (Nom)
        TextNom.Text = ""
        Textprenom.Text = ""
        End If

 

[oxydedefer]

Re : [VBA]Calculé age d 'une personne au jour près

En fait j'ai trouvé !! et surtout grâce à toi j'ai bien compris ton fichier , mais mon projet n'est pas terminé (loin de là ) je serais surement encore dans les environs je le passe en résolut . Merci à vous toutes pour vos réponses !

 

[ROGER2327]

Re : [VBA]Calculé age d 'une personne au jour près(Résolut)

Bonjour à tous

Je m'associe à la remarque de bons sens de pierrejean.

Quant à la fonction diffDateS, méfiance...​

ROGER2327
#5752

Samedi 14 Clinamen 139 (Sortie de Albrecht Dürer, hermétiste - fête Suprême Quarte)
16 Germinal An CCXX, 7,0864h - laitue
2012-W14-4T17:00:26Z

 

[oxydedefer]

Re : [VBA]Calculé age d 'une personne au jour près

Je Reviens encore car je pensais que sa fonctionnait mais non lorsque je veux faire une liste sa plante , j'ai fais un ficher test , j'utilise le macro de PierreJean . Je dois juste pouvoir faire une liste nom+prenom+date de naissance+ age .

 

[ROGER2327]

Re : [VBA]Calculé age d 'une personne au jour près

Bonsoir à tous

(...) je veux faire une liste sa plante (...)

Au minimum, remplacez

Call  DIFDATE(Dated, Datef)

par

ActiveSheet.Cells(numLigneVide, 4).Value = DIFDATE(Dated, Datef)

Je n'ai pas vérifié la validité des résultats.​

ROGER2327
#5760

Mardi 17 Clinamen 139 (Saint Hiéronymus Bosch, démonarque - fête Suprême Quarte)
19 Germinal An CCXX, 9,9839h - radis
2012-W14-7T23:57:41Z

 

[pierrejean]

Re : [VBA]Calculé age d 'une personne au jour près

Re

Merci ROGER

Votre fichier precedent m'a permis d'ameliorer ma fonction afin de permettre aux ecervelés qui ne peuvent integrer le fait qu'une date de debut est à priori inferieure à une date de fin d'avoir néanmoins un resultat exploitable


@ oxydedefer
Un fichier 'presque vide' n'est pas l'idéal pour faire de la mise au point
Si tu ne t'en sors pas avec les indications de ROGER met quelques lignes exemples et on s'en occupera

Function DIFDATE(Dated As Date, Datef As Date) As String
If Not IsNull(Dated) And Not IsNull(Datef) Then
If Datef < Dated Then
 pref = "moins"
 temp = Datef
 Datef = Dated
 Dated = temp
End If
 An = Val(Format(Dated, "yyyy"))
 MN = Val(Format(Dated, "mm"))
 JN = Val(Format(Dated, "dd"))
 
 aa = Val(Format(Datef, "yyyy"))
 MA = Val(Format(Datef, "mm"))
 JA = Val(Format(Datef, "dd"))
 NJMP = "01/" & MA & "/" & aa
 NJMP = DateValue(NJMP) - 1
 NJMP = Val(Format(NJMP, "dd"))
If JN > JA Then
   JA = JA + NJMP
   MA = MA - 1
End If
If MN > MA Then
   MA = MA + 12
   aa = aa - 1
End If
NA = aa - An
NM = MA - MN
NJ = JA - JN
If NA = 0 Then
 NbAn = ""
ElseIf NA = 1 Then
 NbAn = Str$(NA) & " an"
Else
 If NM <> 0 Then
   If NJ <> 0 Then
     NbAn = Str$(NA) & " ans"
   Else
     NbAn = Str$(NA) & " ans et"
   End If
 Else
   NbAn = Str$(NA) & " ans et"
 End If
 If NM = 0 And NJ = 0 Then
   NbAn = Str$(NA) & " ans"
 End If
End If
If NJ = 0 Then
 nbj = ""
ElseIf NJ = 1 Then
 nbj = Str$(NJ) & " jour"
Else
 nbj = Str$(NJ) & " jours"
End If
If NM = 0 Then
 NbM = ""
Else
 If NJ <> 0 Then
  NbM = Str$(NM) & " mois et"
 Else
  NbM = Str$(NM) & " mois"
 End If
End If
 
DIFDATE = Trim(pref & NbAn & NbM & nbj)
Else
 DIFDATE = ""
End If
End Function