Code VBA calcul age

Bonjour j'ai un formulaire avec date aujourdhui et date de naissance je souhaiterais que dans le formulaire sa me donne age dans textbox.

Cordialement

Bonjour,

sous excel avec la date du jour en A1, et celle de la naissance en B1 on aurait en C1 :

=ANNEE(A1)-ANNEE(B1)-SI(ET(MOIS(A1)<=MOIS(B1);JOUR(A1)<JOUR(B1));1;0)

après il faut "transformer" cette façon de voir en VBA...

@ bientôt

LouReeD

bonjour et merci c'est justement sur vba que je sèche

peux pas tout faire !

Bonjour,

Ta cellule A2 comportant la date de naissance, et la cellule A1, la date du jour :

x = DateDiff("yyyy", CDate(Range("A2").Value), CDate(Range("A1").Value))

x = l'âge du gars....

Bon dimanche

Re,

voici une piste, pas très "pro" mais bon :

Sub SonAge()
Dim Age As Integer ' on défini la variable age en "integer"

Age = Year([A1]) - Year([B1]) ' age est égal à l'année de A1 (aujourd'hui) - l'année de B1 (anniversaire)
If Month([A1]) <= Month([B1]) And Day([A1]) < Day([B1]) Then ' si le mois d'aujourd'hui est inférieur ou égal au mois de naissance ET
                                                             ' si le jour d'auhourd'hui est strictement inférieur au jour de naissance
    Age = Age - 1 ' alors Age = Age -1
End If

[C1] = Age ' on inscrit en C1 le résultat du calcul
End Sub
' essayer de remplacer [A1], [B1] et [C1] par les TextBox correspondants : Year(TextBox1.value) etc...

@ bientôt

LouReeD

ce code ne fonctionne pas dans ma textbox.

Re-,

Hummmmm

Tu as vu que j'avais également répondu......

oui oui ami breton

Mais également erreur de code dans ma textbox

Quand j'ouvre formulaire aucun age ne se met dans la textbox

Exact "ami breton" pour les années entières mais moi tant que mon anniversaire n'est pas passé, je n'ai pas vieilli...

Avez vous une solution simple comme la vôtre qui prend en compte le mois et le jour près ?

@ bientôt

Loureed

Ensuite sur le fichier joint pour julien35000 (Rennes) vos dates sont inscrites sur le formulaires en tant que titre de "label", or je ne pense pas qu'un label a une valeur sur laquelle on peut faire des calculs, non ?

Il faudrait remplacer ces labels par des textbox dans un premier temps

@ bientôt

LouReeD

Au fait je connais un peu St Brieux et St Malo....

Voici le label de resultat est en textbox,

j'avais mis label pour ouvrir calendrier pour inserer date je trouvais sa sympa

Bonjour,

Bonjour LouReed,

Une fonction personnalisée pour le calcul d'âge au jour près.

Cdlt.

Option Explicit

Function AGE(Debut As Date, Optional Fin As Date) As String
Dim Nba As Integer, Nbm As Integer, Nbj As Integer, Retenue As Integer
Dim x As String, y As String, z As String

    If Fin = 0 Then Fin = Date
    If Debut > Fin Then
        AGE = "Date de fin  non valide!"
        Exit Function
    End If

    Nba = Year(Fin) - Year(Debut)
    Nbm = Month(Fin) - Month(Debut)
    Nbj = Day(Fin) - Day(Debut)
    Retenue = Day(DateSerial(Year(Fin), Month(Fin), 0))

    If Nbj < 0 Then
        Nbm = Nbm - 1
        Nbj = Nbj + Retenue
    End If

    If Nbm < 0 Then
        Nba = Nba - 1
        Nbm = Nbm + 12
    End If

    x = IIf(Nba = 0, "", IIf(Nba = 1, "1 an", Nba & " ans"))
    If Nbj = 0 Then
        y = IIf(Nbm = 0, "", IIf(x = "", Nbm & " mois", " et " & Nbm & " mois"))
    Else
        y = IIf(Nbm = 0, "", IIf(x = "", Nbm & " mois", ", " & Nbm & " mois"))
    End If
    If x = "" And y = "" Then
        z = IIf(Nbj = 0, "", IIf(Nbj = 1, "1 jour", Nbj & " jours"))
    Else
        z = IIf(Nbj = 0, "", IIf(Nbj = 1, " et 1 jour", " et " & Nbj & " jours"))
    End If

    AGE = x & y & z

End Function

Re-,

Effectivement, autant la fonction "DateDif", dans un onglet est très fiable, autant en VBA, elle est très capricieuse...

Comme je ne peux pas initialiser ton useform (je ne peux pas charger un objet quelconque...), regarde le fichier joint

(Dans la cellule E1, la formule pour un onglet...)

Le code que j'utilise :

Private Sub UserForm_Initialize()
Dim Date1, Date2
Me.TextBox1 = CDate(Sheets("Feuil1").Range("B2").Value)
Me.TextBox2 = CDate(Sheets("Feuil1").Range("B1").Value)
Date1 = Format(Me.TextBox1, "mm/dd/yyyy"): Date2 = Format(Me.TextBox2, "mm/dd/yyyy")
Me.TextBox3 = Evaluate("DATEDIF(" & """" & Date1 & """" & "," & """" & Date2 & """" & "," & """Y""" & ")")
End Sub

Bon courage

Et pour donner également un âge, avec années, mois et jours :

[Selon un code d'Alain Vallon]

Private Sub UserForm_Initialize()
Dim Date1, Date2
Dim An, Mois, Jour
Me.TextBox1 = CDate(Sheets("Feuil1").Range("B2").Value)
Me.TextBox2 = CDate(Sheets("Feuil1").Range("B1").Value)
Date1 = Format(Me.TextBox1, "mm/dd/yyyy"): Date2 = Format(Me.TextBox2, "mm/dd/yyyy")
An = Evaluate("DATEDIF(" & """" & Date1 & """" & "," & """" & Date2 & """" & "," & """Y""" & ")")
Mois = Evaluate("DATEDIF(" & """" & Date1 & """" & "," & """" & Date2 & """" & "," & """YM""" & ")")
Jour = Evaluate("DATEDIF(" & """" & Date1 & """" & "," & """" & Date2 & """" & "," & """MD""" & ")")

plurAn = Evaluate("if(" & An & ">1" & "," & """ ans""" & "," & """ an""" & ")")
plurJour = Evaluate("if(" & Jour & ">1" & "," & """ jours""" & "," & """ jour""" & ")")
Me.TextBox3 = An & plurAn & " " & Mois & " mois" & " " & Jour & plurJour
End Sub

Fichier :

Bonjour

Alors cela vous convient-il ?

@ bientôt

LouReeD

bonjour,

oui effectivement cela marche parfaitement bien

Merci pour l'aide encore