[Resolvido]Calcular tempo baseado na data do sistema

Boa noite senhores não entendo quase nada de VBA e consegui o código abaixo  na internet para calcular idade:
Public Function fncIdadeCompleta(DataNascimento As Date, Optional DataFinal As Date) As String
On Error GoTo trataerro
Dim Anos As Byte, Meses As Variant, Dias As Byte, DataRef As Date
If DataNascimento > DataFinal Or DataNascimento = 0 Or DataFinal = 0 Then
   fncIdadeCompleta = ""
   Exit Function
End If
If DataNascimento = DataFinal Then
   fncIdadeCompleta = 0
   Exit Function
End If


'Ajusta dataNascimento se cair em ano bissexto
DataNascimento = IIf(Format(DataNascimento, "mm/dd") = "02/29", DataNascimento - 1, DataNascimento)

Anos = DateDiff("d", DataNascimento, DataFinal) \ 365.25
DataRef = DateSerial(Year(DataFinal) + (Format(DataNascimento, "mmdd") > Format(DataFinal, "mmdd")), Format(DataNascimento, "mm"), Format(DataNascimento, "dd"))
Meses = DateDiff("m", DataRef, DataFinal) + (Format(DataNascimento, "dd") > Format(DataFinal, "dd"))
DataRef = DateSerial(Year(DataFinal), Format(DataFinal, "mm") + (Format(DataNascimento, "dd") > Format(DataFinal, "dd")), Format(DataNascimento, "dd"))
DataRef = IIf(Format(DataNascimento, "dd") <> Format(DataRef, "dd"), DataRef - Format(DataRef, "dd"), DataRef)
Dias = CDbl(DataFinal) - CDbl(DataRef)
fncIdadeCompleta = 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 ")
sair:
   Exit Function
trataerro:
   MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
   Resume sair:
End Function


Como adaptar esse código para calcular uma idade baseada na data atual do sistema.

obrigado!

Ola

O código já faz isso mesmo, calcula a idade pela Data de Nascimento e Data atual do sistema;

Código:

?fncIdadeCompleta(#26-11-1965#,Date())

51 anos 4 meses 2 dias

Bom dia J Paulo, obrigado pela atenção mas vou explicar melhor o que preciso.

Tenho o cadastro de documentos que possuem uma determinada validade.

Por exemplo um documento que foi expedido em 10/03/2017 e validade de 26/06/2017

No Bd tenho o campo Dt_Exp 10/03/2017 e Dt_Validade 26/06/2017

Na verdade preciso calcular a diferença em anos, meses e dias entre Dt_Validade e a data do sistema.

Nesse caso, no código, basta mudar a Data de Nascimento pela Dt_Validade considerando que a data final seria a data do sistema?

Obrigado.

Para o seu caso, recomendo usar o simples;

Faça a sua consulta (query) normal com esses campos, acrescente num campo novo o seguinte;

Código:

AlertaValidade: DateDiff("yyyy";Date();[Dt_Validade]) & " anos,  " & DateDiff("m";Date();[Dt_Validade]) & " meses,  " & DateDiff("d";Date();[Dt_Validade]) & " dias"

Veja o resulto e retorne.

Boa tarde!

Essa consulta eu já fiz.
A formula abaixo:

AlertaValidade: DateDiff("yyyy";Date();[Dt_Validade]) & " anos, " & DateDiff("m";Date();[Dt_Validade]) & " meses, " & DateDiff("d";Date();[Dt_Validade]) & " dias"

Retorna um valor 0 anos, 3 meses, 90 dias e deveria ser por exemplo 0 anos, 3 meses, 0 dias

Com a ajuda do forum usei a fórmula:
Dias Restantes: DifData("yyyy";Agora();[Dt_Validade]) & " Ano(s)," & DifData("d";Mês(Agora());Mês([Dt_Validade])) & " Meses, " & DifData("d";Dia(Agora());Dia([Dt_Validade])) & " Dia(s)"

Quer retorna o valor 0 Ano(s),3 Meses, -2 Dia(s)

A resposta certa seria 0 anos, 2 meses, 29 Dias

Por essa razão pensei em um código.

obrigado.

Teste por favor e retorne;

Deve chamar a função desta forma, num novo campo da sua consulta;

Dias Restantes:CalculaAnosMesesDias(Date();[Dt_Validade])

Código:

Public Function CalculaAnosMesesDias(DataInicio As Date, DataFim As Date) As String
Dim intConta As Integer
Dim intCdia As Integer

   intConta = Int(DateDiff("m", DataInicio, DataFim)) + (DataFim < DateSerial(Year(DataFim), Month(DataFim), Day(DataInicio)))
  If intConta < 0 Then intConta = 0

   If Day(DataFim) < Day(DataInicio) Then
      intCdia = DateDiff("d", DataInicio, DateSerial(Year(DataInicio), Month(DataInicio) + 1, 0)) + Day(DataFim)
   Else
      intCdia = Day(DataFim) - Day(DataInicio)
   End If
  
   CalculaAnosMesesDias = Int(intConta / 12) & " ano" _
   & IIf(Int(intConta / 12) <> 1, "s ", " ") _
   & intConta Mod 12 & " mes" & IIf(intConta Mod 12 <> 1, "es ", " ") _
   & LTrim(Str(intCdia)) & " dia" & IIf(intCdia <> 1, "s", "")
Exit Function
End Function

Boa tarde JPaulo, obrigado pela atenção.

Criei a função e inseri a fórmula Dias Restantes:CalculaAnosMesesDias(Date();[Dt_Validade]) em um novo campo da consulta, no entanto ocorreu o erro.

Função 'CalculaAnosMesesDias' indefinida na expressão.

O que pode ser?

Só falta isso para funcionar.

Obrigado!

Cole a função num modulo.

Boa JPaulo.

Vou precisar de orientação porque eu criei um módulo, conforme o anexo.

Deve estar faltando alguma coisa.

obrigado

Escreva Public antes do Function e teste.

Boa noite JPaulo.

Ainda não funcionou.

Coloco em anexo o BD. A consulta é a consulta "Tempo Funcao".

obrigado

Teste e retorne por favor;

Download

Beleza JPaulo.

Funcionou perfeito.

Eu estou errando no fazer o módulo, pois o meu com o código igualzinho ao seu dava a mensagem de erro. Quando eu importei o módulo que vc disponibilizou funcionou.

Obrigado.

Fico feliz.

Obrigado pelo retorno o forum agradece.