[Resolvido]Calcular idade com data final distinta do sistema

Boa noite.
Como faço para calcular no formulário  a idade completa, com ano, mês e dia.
Usando duas datas
Data inicial será a de nascimento
Data final será a data que eu colocar no campo data do ato.
Sei que tem muitos exemplos de como calcular, mas não gostaria de usar o now, ou seja,  a data do sistema como data final.
Grato pela atenção.

Amigo, eu ate vi um modulo parecido com o que voce precisa o... Vou vasculhar meus exemplos aqui se achar te passo...

Achei, mas tera que adaptar para sua realidade, pois dessa forma ele usa a Data2 como sendo a data atual..

Crie um Modulo com isso:

Código:


Option Compare Database

Public Function AnoMesDia(dtData1 As Date) As String
On Error GoTo AnoMesDia_Err

  Dim sTmp As String
  Dim nDMA As Long
  Dim NewDate As Date
  Dim sSngPlural As String
  Dim dtData2 As Date
  
'Aqui ele assume a Data atual como sendo a Segunda Data.
  dtData2 = Now
  
  ' Bloco Ano ---------------------
  ' Calcula número inteiro de anos
  nDMA = DateDiff("yyyy", dtData1, dtData2)
  ' Se Data1+nDMA>Data2, subtrai 1 ano
  If DateAdd("yyyy", nDMA, dtData1) > dtData2 Then
    nDMA = nDMA - 1
  End If
  sSngPlural = " ano, "
  If nDMA > 1 Then sSngPlural = " anos, "
  sTmp = nDMA & sSngPlural
  
  ' Bloco Mês ---------------------
  ' Nova data de referência
  NewDate = DateAdd("yyyy", nDMA, dtData1)
  nDMA = DateDiff("m", NewDate, dtData2)
  ' Se Data1+nDMA>Data2, subtrai 1 mês
  If DateAdd("m", nDMA, NewDate) > dtData2 Then
    nDMA = nDMA - 1
  End If
  sSngPlural = " mês e "
  If nDMA > 1 Then sSngPlural = " meses e "
  sTmp = sTmp & nDMA & sSngPlural
  
  ' Bloco Dia ---------------------
  NewDate = DateAdd("m", nDMA, NewDate)
  nDMA = DateDiff("d", NewDate, dtData2)
  sSngPlural = " dia"
  If nDMA > 1 Then sSngPlural = " dias"
  sTmp = sTmp & nDMA & sSngPlural
  
  ' Valor final da função
  AnoMesDia = sTmp
  
AnoMesDia_Fim:
  Exit Function
AnoMesDia_Err:
  MsgBox Err.Description
  Resume AnoMesDia_Fim
End Function


Para Calcular crie uma caixa de Texto Nao associada e coloque assim:
Na propriedade do campo, Fonte de Controle coloque:

=AnoMesDia([txtDataNascimento])

AnoMesDia é qnd ele chama a função do Modulo.
txtDataNascimento é onde tem a Data de Nascimento...



Fonte: Exemplo retirado aqui do Site, mas não sei quem e o dono...

Adaptei esta função para você, não testei ainda, veja se funciona

cole a função em um módulo e depois onde quiser utilizá-la use: call fncIdadeCompleta2(suadatanascimento, datadoato)

Código:


Public Function fncIdadeCompleta2(DataNascimento As Date, data_ato As Date) As String
Dim Anos As Byte, Meses, Dias As Byte, DataRef As Date
Dim Resultado As Boolean, AjustaAno As Date
On Error GoTo y1
If DataNascimento > data_ato Or DataNascimento = 0 Or IsNull(DataNascimento) Then
    fncIdadeCompleta2 = ""
    Exit Function
End If

If DataNascimento = data_ato Then
    fncIdadeCompleta2 = 0
    Exit Function
End If
 
'Ajusta ano bissexto
DataNascimento = IIf(Format(DataNascimento, "mm/dd") = "02/29", DataNascimento - 1, DataNascimento)
 
'Ajusta cálculo para aniversário de 1 ano
AjustaAno = IIf(DateDiff("d", DataNascimento, data_ato) = 365, 365.25, DateDiff("d", DataNascimento, data_ato))
 
Anos = Int(AjustaAno / 365.25)
 
Resultado = (Format(DataNascimento, "mmdd") > Format(data_ato, "mmdd"))

DataRef = DateSerial(Year(data_ato) + Resultado, Format(DataNascimento, "mm"), Format(DataNascimento, "dd"))

Meses = DateDiff("m", DataRef, data_ato) + (Format(DataNascimento, "dd") > Format(data_ato, "dd"))
 
Resultado = (Format(DataNascimento, "dd") > Format(data_ato, "dd"))

DataRef = DateSerial(Year(data_ato), Format(data_ato, "mm") + Resultado, Format(DataNascimento, "dd"))
DataRef = IIf(Format(DataNascimento, "dd") <> Format(DataRef, "dd"), DataRef - Format(DataRef, "dd"), DataRef)

Dias = CDbl(data_ato) - CDbl(DataRef)
'fncIdadeCompleta2 = Anos '+ IIf(Meses >= 1, Meses / 12, 0) + IIf(Dias >= 1, Dias / 365, 0)
fncIdadeCompleta2 = IIf(Anos <= 1, IIf(Anos = 0, "", Anos & " ano "), Anos & " anos ") & _
                              IIf(Meses <= 1, IIf(Meses = 0, "", Meses & " mes "), Meses & " meses ") & _
                              IIf(Dias <= 1, IIf(Dias = 0, "", Dias & " dia "), Dias & " dias ")
y1:
End Function




Fiz aqui um exemplo de acordo com o que você precisa... Calculando com duas datas....

fabiopaes,

Muito obrigado pela atenção!
Funcionou da forma como imaginava.
Você é fera.
Obrigado.

Valeu!!!

Valeu! Mas nao e de minha criação!!!

E daqui do Site mesmo!

A galera aqui é que é Fera!!!