[Resolvido] Calcular idade exata com DifData

Salve galera,

Boa noite. Tenho um campo chamado [DataNascimento] e um outro campo chamado [Idade] que no caso me retorna um valor de acordo com a data inserida no campo [DataNascimento]. O que eu gostaria era que ao digitar a data, no campo [DataNascimento] do form, aparecesse no campo [Idade], a idade da pessoa exata de acordo com a data atual. A principio estou usando a expressão =DifData("yyyy";[datanascimento];Data()), esta expressão me retorna o valor certo porém não exato. É possível usar a função DifData para calcular uma idade exata de acordo com o campo [DataNascimento] e o campo [Idade]? Desde já agradeço a atenção de todos valeu!

Bom dia,

Procure no fórum pela função CalculaIdade

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.

Então aqui vai uma bem simples, espero que ajude

Function CalculaIdade(DataNasc As Variant) As Variant
''Recebe a DataNasc e devolve a Idade em Anos

On Error GoTo Idade_Err

''Evita o erro de data não preenchida
If IsNull(DataNasc) Then
CalculaIdade = ""
Exit Function
End If

''Declarando Variáveis
Dim DataHoje As Variant, DiaHoje As Integer
Dim MesNasc As Integer, DiaNasc As Integer
Dim DifAnos As Integer, MesHoje As Integer

''Isola as partes (dia/mês) das duas datas
DiaHoje = DatePart("d", Now)
MesHoje = DatePart("m", Now)
DiaNasc = DatePart("d", DataNasc)
MesNasc = DatePart("m", DataNasc)

''Calcula a diferença de anos
DifAnos = DateDiff("yyyy", DataNasc, Now)

''Verifica dia/mês de nascimento
If MesHoje < MesNasc Then
DifAnos = DifAnos - 1
ElseIf MesHoje = MesNasc Then
If DiaHoje < DiaNasc Then
DifAnos = DifAnos - 1
End If
Else
End If

''Valor final da função
CalculaIdade = DifAnos

Idade_Fim:
Exit Function

Idade_Err:
MsgBox Err.Description
Resume Idade_Fim

End Function

No meu trabalho mais recente eu tenho os campos "txtNascimento" e "txtIdade" e coloquei assim, no evento "Após atualizar" do campo "txtNascimento":

If IsNull(Me.txtNascimento) Or Me.txtNascimento.Value = "" Then
MsgBox "Insira a data de nascimento", VbOkOnly, "Atenção"
Cancel = True
Exit Sub
End If

If Month(txtNascimento) > Month(Date) Then
Me.txtIdade = DateDiff("yyyy", txtNascimento, txtHoje) - 1
ElseIf Month(txtNascimento) < Month(Date) Then
Me.txtIdade = DateDiff("yyyy", txtNascimento, txtHoje)
ElseIf Month(txtNascimento) = Month(Date) Then
If Day(txtNascimento) <= Day(txtHoje) Then
Me.txtIdade = DateDiff("yyyy", txtNascimento, txtHoje)
ElseIf Day(txtNascimento) > Day(txtHoje) Then
Me.txtIdade = DateDiff("yyyy", txtNascimento, txtHoje) - 1
End If
End If

Essa função só não checa se a data inserida é maior do que a data atual, porque para esse projeto isso não se faz necessário, mas é fácil implementar caso precise.

Aqui mesmo na sala de Exemplos tem, é só aproveitar o que existe neste fórum.

http://maximoaccess.forumeiros.com/repositorio-de-exemplos-ms-access-f7/calcula-idade-t283.htm

boa noite, pessoal.

Muito obrigado pelas respostas. Eliminei a dúvida baseando nas dicas acima ... valeu a todos!

Criquio,

Tentei adaptar o seu código para uma rotina em que preciso contar quantos meses de atraso desde a data de vencimento de um pagamento. A função Datediff não serve no meu caso, porque preciso saber a diferença com base em uma data específica e ela só conta quando vira o mês. Tentei adaptar este código seu (para contar idade), mas tem dado erro 94 "Uso de Null Inválido".

Private Sub txtvenc_AfterUpdate()
If IsNull(Me.txtvenc) Or Me.txtvenc.Value = "" Then
MsgBox "Insira a data de vencimento", vbOKOnly, "Atenção"
Cancel = True
Exit Sub
End If

If Month(txtvenc) > Month(Date) Then
Me.txtatraso = DateDiff("yyyy", txtvenc, txthoje) - 1
ElseIf Month(txtvenc) < Month(Date) Then
Me.txtatraso = DateDiff("yyyy", txtvenc, txthoje)
ElseIf Month(txtvenc) = Month(Date) Then
If Day(txtvenc) <= Day(txthoje) Then[/color] 'ESTA LINHA FICA MARCADA EM AMARELO
Me.txtatraso = DateDiff("yyyy", txtvenc, txthoje)
ElseIf Day(txtvenc) > Day(txthoje) Then
Me.txtatraso = DateDiff("yyyy", txtvenc, txthoje) - 1
End If
End If
End Sub

'"MENSAGEM: Erro em tempo de execução "94" - Uso de Null inválido."

Veja se você pode me ajudar, por favor.