Convidado 5/8/2010, 12:18
Bom dia Michel,
Fuçando em meus arquivos, achei essa:
Function CalculaIdade(DataNascimento As Date, Optional Tipo As Integer) As String
' ================================================================================
' Objetivo: Calcula idade e ou periodo entre uma data qualquer e o dia de
' hoje.
' Parametros: DataNascimento - Data a Calcular
' Tipo - 1 : Retorna resultado somente em anos. (Default)
' 2 : Retorna resultado em anos e meses.
' 3 : Retorna resultado em anos, meses e dias.
' Ambiente: Access 97
' Autor: Carlos Machado / Adaptação: Rogerio Olimpio Versao: 1.5
' Bug corrigido: erro no mes de fevereiro
' ===============================================================================
If IsNull(DataNascimento) Then
CalculaIdade = ""
Exit Function
End If
Dim intAnos As Integer, intMeses As Integer, intDias As Integer
Dim AnoHoje As Integer, DiaHoje As Integer, MesHoje As Integer
Dim DiaNasc As Integer, MesNasc As Integer, AnoNasc As Integer
Dim DataAux
Dim TmpDia, resto As Byte
DiaHoje = Day(Now)
MesHoje = Month(Now)
AnoHoje = Year(Now)
DiaNasc = Day(DataNascimento)
MesNasc = Month(DataNascimento)
AnoNasc = Year(DataNascimento)
'Calcula anos
intAnos = AnoHoje - AnoNasc
'Calcula meses e dias; ajusta anos
If MesHoje = MesNasc Then
If DiaHoje < DiaNasc Then
intAnos = intAnos - 1
intMeses = 11
DataAux = DateAdd("m", -1, DateValue(DiaNasc & "/" & MesHoje & "/" & AnoHoje))
intDias = Int(Now - DataAux)
ElseIf DiaHoje = DiaNasc Then
intMeses = 0
intDias = 0
Else
intMeses = 0
intDias = Int(Now - DateValue(DiaNasc & "/" & MesHoje & "/" & AnoHoje))
End If
ElseIf MesHoje < MesNasc Then
intAnos = intAnos - 1
If DiaNasc = 29 And MesNasc = 2 Then
intMeses = DateDiff("m", DateValue(DiaNasc - 1 & "/" & MesNasc & "/" & AnoHoje - 1), Now)
Else
intMeses = DateDiff("m", DateValue(DiaNasc & "/" & MesNasc & "/" & AnoHoje - 1), Now)
End If
If DiaHoje = DiaNasc Then
intDias = 0
ElseIf DiaHoje < DiaNasc Then
intMeses = intMeses - 1
TmpDia = DiaNasc
resto = 0
While Not IsDate(TmpDia & "/" & MesHoje & "/" & AnoHoje)
TmpDia = TmpDia - 1
resto = resto + 1
Wend
DataAux = DateAdd("m", -1, DateValue(TmpDia & "/" & MesHoje & "/" & AnoHoje))
intDias = Int(Now - DataAux) - resto
Else
intDias = Int(Now - DateValue(DiaNasc & "/" & MesHoje & "/" & AnoHoje))
End If
Else
intMeses = DateDiff("m", DateValue(DiaNasc & "/" & MesNasc & "/" & AnoHoje), Now)
If DiaHoje = DiaNasc Then
intDias = 0
ElseIf DiaHoje < DiaNasc Then
intMeses = intMeses - 1
TmpDia = DiaNasc
resto = 0
While Not IsDate(TmpDia & "/" & MesHoje & "/" & AnoHoje)
TmpDia = TmpDia - 1
resto = resto + 1
Wend
DataAux = DateAdd("m", -1, DateValue(TmpDia & "/" & MesHoje & "/" & AnoHoje))
intDias = Int(Now - DataAux) - resto
Else
intDias = Int(Now - DateValue(DiaNasc & "/" & MesHoje & "/" & AnoHoje))
End If
End If
If Nz(Tipo) = 0 Then
CalculaIdade = intAnos & " anos."
ElseIf Nz(Tipo) = 2 Then
CalculaIdade = intAnos & " anos e " & intMeses & " meses."
ElseIf Nz(Tipo) = 3 Then
CalculaIdade = intAnos & " anos, " & intMeses & " meses e " & intDias & " dias"
End If
CalculaIdade_Fim:
Exit Function
CalculaIdade_Err:
MsgBox err.Description
Resume CalculaIdade_Fim
End Function
Deve ter alguma mais simples.
Nivaldo.