• Home
 · 
• Miscellaneous
 · 
• This code allow you to know how old you are, but its more precise...

This code allow you to know how old you are, but its more precise...

This code allow you to know how old you are, but its more precise...

API Declarations



P.S.: I'from Brazil...



Rate This code allow you to know how old you are, but its more precise...

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Function CalcAge(DataNasc As Date)
'Desenvolvido por © Alex Prado de Carvalho ®
'Data: Mai/1999
    
    If IsNull(DataNasc) Or DataNasc > Date Then
        MsgBox "Data de nascimento inválida!", vbExclamation, "Erro"
        Exit Function
    End If
    Dim Anos, meses, dias
    Dim iAnos As Double, iMeses As Double, Intervalo As Double
    
    ' O resultado da diferença está em Double
    Intervalo = Date - DataNasc
    
    ' Um ano tem exatamente 365,25 dias
    iAnos = Intervalo / 365.25
    Anos = Int(iAnos)
    iMeses = (iAnos - Anos) * 12
    meses = Int(iMeses)
    
    dias = DateDiff("d", DateSerial(DatePart("yyyy", DataNasc) + Anos, DatePart("m", DataNasc) + meses, Day(DataNasc)), Date)
    
    If dias = 30 Then
        dias = 0
        meses = meses + 1
    End If
    
    If meses = 12 Then
        meses = 0
        Anos = Anos + 1
    End If
    
Fim:
    If Anos > 1 Then
        Anos = Anos & " anos "
    Else
        Anos = Anos & " ano "
    End If
        
    If meses > 1 Then
        meses = meses & " meses "
    Else
        meses = meses & " mês "
    End If
    
    If dias > 1 Then
        dias = dias & " dias"
    Else
        dias = dias & " dia"
    End If
        
    CalcAge = Anos & meses & dias

End Function