[Resolvido]Calcular Idade com data futura

Olá sou novo no fórum e também no Access, não tenho experiência.
Tenho em um formulário um campo que calcula a idade, tutorial seguido pelo youtube: https://www.youtube.com/watch?v=EWkm0Vs0qQQ

Muito bom e que funciona perfeitamente, no entanto preciso calcular a idade não com a data atual, mas sim com uma data futura, pois preciso separar por faixa etária (grupos) os jovens.
Ex.: Quantos anos fulano terá no próximo carnaval? No caso dia 04/05/2014.

Os códigos que eu achei até o momento só fazem o cálculo com a data atual.

Segue o banco de dados:
https://drive.google.com/file/d/0B9kFGm5ygI8XWVFvN09YOWNYS2s/edit?usp=sharing

Atualmente trabalho com o banco de dados alterando a hora do sistema mas queria colocar isso no banco de dados para que outras pessoas pudessem utilizar em outros pc's

Desde já agradeço a atenção e colaboração, e toda a ajuda recebida.

Olá, bem vindo ao fórum,qual serial o campo do formulário que receberia a idade?

Copie esse código e cole ele no vba do seu formulário:

Function VerificaIdade(DATA_NASCIMENTO As Variant) As Variant

On Error GoTo VerificaIdade_Err

If IsNull(DATA_NASCIMENTO) Then
VerificaIdade = ""
Exit Function
End If

Dim DtAtual As Variant, DiaAtual As Integer
Dim MesNasc As Integer, DiaNasc As Integer
Dim DifAnos As Integer, MesAtual As Integer

DiaAtual = DatePart("d", Now)
MesAtual = DatePart("m", Now)
DiaNasc = DatePart("d", DATA_NASCIMENTO)
MesNasc = DatePart("m", DATA_NASCIMENTO)

DifAnos = DateDiff("yyyy", DATA_NASCIMENTO, Now)

If MesAtual < MesNasc Then
DifAnos = DifAnos - 1
ElseIf MesAtual = MesNasc Then
If DiaAtual < DiaNasc Then
DifAnos = DifAnos - 1
End If
Else
End If

VerificaIdade = DifAnos

VerificaIdade_Fim:
Exit Function

VerificaIdade_Err:
MsgBox Err.Description
Resume VerificaIdade_Fim

End Function


na propriedade "Fonte do Controle" do campo que vai mostrar a idade coloque:
=VerificaIdade([DATA_NASCIMENTO])

Data_Nascimento é o campo Data de Nascimento do seu formulário. evite usar espaços em nomes de campos pra evitar erros quando for referir-se ao campo, renomeie para o nome que citei.

Olá betogivoni, muito obrigado pela ajuda, mas acho que não me expressei muito bem.
Pelo tutorial que segui funcionou, "https://www.youtube.com/watch?v=EWkm0Vs0qQQ", só que não sei como fazer que este código calcule com uma data futura, exatamente dia 04/03/2014, data do carnaval do ano que vem, pois preciso saber quantos anos o jovem vai ter até essa data. Por que se alguém fizer aniversário um dia depois vai ser direcionado para outro grupo devido a idade.

As faixas etárias são:
Peq. Comp.: 2 a 10 anos
Pólem: 11 e 12 anos
Sementes: 13 e 14 anos
Flores: 15 a 17 anos
Colheita: 18 a 20 anos
Tarefeiros: 21 a 24 anos

Está é a função que o Lucio Rezena, explica no tutorial e que funcionou, fiz algumas adaptações devido a necessidade para entendimento e funcionamento do código para o meu caso.
====================================
Function CalcularIdade(DATA_DE_NASCIMENTO As Date)

Dim Anos, Meses, Dias
Dim iAnos As Double, iMeses As Double, Intervalo As Double
Intervalo = Date - DATA_DE_NASCIMENTO
iAnos = Intervalo / 365.25

Anos = Int(iAnos)
iMeses = (iAnos - Anos) * 12
Meses = Int(iMeses)

Dias = DateDiff("d", DateSerial(DatePart("yyyy", DATA_DE_NASCIMENTO) + Anos, DatePart("m", DATA_DE_NASCIMENTO) + Meses, Day(DATA_DE_NASCIMENTO)), Date)

If Dias >= 30 Then
Dias = 0
Meses = Meses + 1
End If

If Meses >= 12 Then
Meses = 0
Anos = Anos + 1
End If

Ajustes:
If Anos > 1 Then
Anos = Anos & " anos "
Else
Anos = Anos & " ano "
End If

If Anos > 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

CalcularIdade = Anos

End Function
====================================
Dentro desse código não sei onde poderia modificar para fazer esse calculo de idade com a data sendo futura.
Vou tentar a sua dica, e posto aqui o resultado. Muito obrigado novamente.

Olá Sandro,

Coloca uma caixa de texto no teu formulário (ex. TxtDataFutura). Essa caixa vai receber a data futura para o calculo.

Altera a seguinte linha do código:

Onde tem: Intervalo = Date - DATA_DE_NASCIMENTO

Altera para: Intervalo = Me.TxtDataFutura - DATA_DE_NASCIMENTO

Não testei, más deve funcionar.


Nivaldo.

uma pergunta amigo, vc quer saber essa idade futura hoje, ou quando chegar na data do aniversário da pessoa? Se for a primeira opção tem que seguir a dica do Nivaldo criar uma caixa de texto para digitar essa data futura, agora se for a segunda opção esse código que te passei vai funcionar, é só fazer o teste nesse exemplo, se você abrir o formulário as pessoas que estão no cadastro vão estar com os anos atuais, mas se você mudar a data do sistema para os anos subsequentes e abir o form. vai observar que os anos foram corrigidos (alterados) para as idades atuais.

Olá, Nivaldo e betogivoni!

Testei primeiramente no código do Lucio Rezena, conforme as orientações do Nivaldo, mas não funcionou. Passei então a testar no código do betogivoni, alterei apenas aonde estava escrito "Now" para "Me.TxtDataFutura" defini o valor padrão do campo "TxtDataFutura" para a data 04/03/2014, e ai funcionou perfeitamente.

Suas dicas foram perfeitas.

Muito obrigado pela ajuda!!!!!!!!!!!!!!!!

Segue o código e o banco de dados.
===============================
Function VerificaIdade(DATA_NASCIMENTO As Variant) As Variant

On Error GoTo VerificaIdade_Err

If IsNull(DATA_NASCIMENTO) Then
VerificaIdade = ""
Exit Function
End If

Dim DtAtual As Variant, DiaAtual As Integer
Dim MesNasc As Integer, DiaNasc As Integer
Dim DifAnos As Integer, MesAtual As Integer

DiaAtual = DatePart("d", Me.TxtDataFutura)
MesAtual = DatePart("m", Me.TxtDataFutura)
DiaNasc = DatePart("d", DATA_NASCIMENTO)
MesNasc = DatePart("m", DATA_NASCIMENTO)

DifAnos = DateDiff("yyyy", DATA_NASCIMENTO, Me.TxtDataFutura)

If MesAtual < MesNasc Then
DifAnos = DifAnos - 1
ElseIf MesAtual = MesNasc Then
If DiaAtual < DiaNasc Then
DifAnos = DifAnos - 1
End If
Else
End If

VerificaIdade = DifAnos

VerificaIdade_Fim:
Exit Function

VerificaIdade_Err:
MsgBox Err.Description
Resume VerificaIdade_Fim

End Function
=========================
Aonde é a parte gráfica até consigo desenvolver um pouco, mas quando vai pra programação ai sou leigo. rsrsrsr. Agora posso começar a cadastrar os participantes do evento.

Meus sinceros votos de Paz, Luz, Amor, Fraternidade e Prosperidade, que 2014 chegue trazendo boas vibrações para vocês e suas famílias. Que Deus abençoe sempre!!!!!!!!!!!
Muito obrigado novamente pela ajuda!!!!!!!!!!!!!!!!!!!

O Fórum agradece o Retorno.

Não se esqueça de clicar no botão de resolvido!
Desta vez eu coloco.


Moderação