Calcular Idade

[Edson_csi]

Bom dia!

Tenho um formulário com um campo data (MakedBox), e um campo idade (TextBox).

Gostaria de saber se existe uma fórmula para q ao seja inserido a data de nascimento, seja calculado a idade automático.

Obrigado!

[Macêdo]

fiz o seguinte e deu certo, então é só você ver o código e ajustar ao seu projeto beleza ?

Insira três textbox, depois cole o código abaixo no form_load (o text1 será onde coloca a data de nacismento)(o text2 chama a data atual) ( o text3 aparece a idade)

Private Sub Form_Load()

Text1.Text = CDate("5/12/1977")

Text2.Text = CDate(Date)

Dim vDataInicial As Date

Dim vDatafinal As Date

vDataInicial = CDate(Text1.Text)

vDatafinal = CDate(Text2.Text)

Text3.Text = (vDatafinal - vDataInicial) / 365

End Sub

[Duduh_Capixaba]

Macêdo, segui seu código, mas percebi que quando eu colocava uma data próxima a data atual o cálculo furava. Exemplo:

hoje é dia: 08/10/2007

nascimento: 09/10/1983

idade: 23

Mas o programa me devolve 24. Entre os dias 09/10 e 14/10 ele faz isso, antes ou depois dessa data fica certo. Minha solução:

Private Sub MaskEdBox1_LostFocus()

Dim DtNasc, DtAtual As Date

Dim Idade, Resto As Integer

DtNasc = CDate(MaskEdBox1.Text)

DtAtual = CDate(Date)

Resto = (DtAtual - DtNasc) Mod 365

Idade = (DtAtual - DtNasc) \ 365 'Não é erro de digitação, é uma barra invertida mesmo!

If Resto >= 0 And Resto <= 5 Then

Text1.Text = Idade - 1

Else

Text1.Text = Idade

End If

End Sub

Essa diferença deve ocorrer por causa dos anos bissextos. Verifica aí e veja se é isso mesmo!

Editado Outubro 8, 2007 por Duduh_Capixaba

[kuroi]

Essa diferença deve ocorrer por causa dos anos bissextos. Verifica aí e veja se é isso mesmo!

realmente, ocorre essa diferenca porque os anos bissextos tem 366 dias. como a divisao é feita por 365, cada ano bissexto q o cara viver a diferenca vai dar 1 dia a mais.

a solucao pra isso está aqui: http://scriptbrasil.com.br/forum/index.php?showtopic=108907

EDITADO:

Duduh_Capixaba, quanto ao seu codigo, não entendi sua logica. testei aqui e tb achei um problema. exemplo, se o cara nasceu em 28/02/2007 e hj for 28/02/2008 ele devia ter 1 ano, mas ele retorna 0. mesmo se eu setar a data pra 29/02/2008 (ele devia ter 1 ano e 1 dia) ele tb retorna 0.

bom mas deem uma olhada na funcao q eu passei no link q parece estar funcionando sem problemas.

Editado Outubro 9, 2007 por kuroi

[Duduh_Capixaba]

nossa cara...minha lógica tá totalmente errada!!! na verdade eu consertei um erro e criei outro, hehe...melhor seguir o exemplo do link que você passou. vlw pela correção!

[Duduh_Capixaba]

Kuroi, dei uma mexida no meu código, queria que você desse uma olhada:

Private Sub MaskEdBox1_LostFocus()

Dim DtNasc, DtAtual As Date

Dim Idade As Single

DtNasc = CDate(MaskEdBox1.Text)

DtAtual = CDate(Date)

If Day(DtNasc) > Day(DtAtual) And Month(DtNasc) >= Month(DtAtual) Then

Idade = Year(DtAtual) - Year(DtNasc) - 1

Else

Idade = Year(DtAtual) - Year(DtNasc)

End If

If Idade < 0 Then Idade = 0

Text1.Text = Idade

End Sub

Fiz vários testes e não encontrei erro. Gostaria que o pessoal testasse tb. Vlw, abraço!

[kuroi]

opa seu codigo parece q ta funcionando legal!! e bem mais simples q o meu. o meu parece q funciona tb mas é bem complicado e gde.

só achei um problema no seu.

se o cara nasce em 29/02/2004, quando chegar 29/02/2008 ele vai ter 4 anos, certo?? agora e em 2009?? feverero tem só 28 dias. então ele deveria ter 5 anos em 28/02/2009, certo?? so q a sua formula diz q ele teria só 4. e ele só faria 5 em 01/03/2009.

então ve ai se é isso mesmo e se você consegue resolver. porque parece q é só esse mesmo o problema.

ai posta ai q eu apago aquela minha funcao e ponho a sua no lugar, beleza??

[Duduh_Capixaba]

beleza Kuroi, assim que der eu dou uma olhada nesse problema do dia 29 de fevereiro. Mas não tira sua função não cara, ela ficou muito 10! Fiquei impressionado com a complexidade do cálculo :P é loucura e ainda funciona 100%. Vlw, abraço!

O código anterior possui um erro:

hoje: 11/10/2007

nascimento: 16/12/2000

idade: 6 anos

Se você colocar nascimento 01/12/2007 ele vai te dar 7 anos. Isso porque ele está dando prioridade para o dia, e não para o mês. Corrigindo o código:

Dim DtNasc, DtAtual As Date

Dim Idade As Single

DtNasc = CDate(MaskEdBox1.Text)

DtAtual = CDate(Date)

If Month(DtNasc) > Month(DtAtual) Then

Idade = Year(DtAtual) - Year(DtNasc) - 1

ElseIf Month(DtNasc) = Month(DtAtual) Then

If Day(DtNasc) > Day(DtAtual) Then

Idade = Year(DtAtual) - Year(DtNasc) - 1

Else

Idade = Year(DtAtual) - Year(DtNasc)

End If

Else

Idade = Year(DtAtual) - Year(DtNasc)

End If

If Idade < 0 Then Idade = 0

Text1.Text = Idade

End Sub

As condições são:

1) o mês de nascimento ser maior que o mês atual

2) o mês de nascimento ser igual ao mês atual mas o dia ser maior

3) o mês de nascimento ser igual ao mês atual mas o dia ser menor

4) o mês de nascimento ser menor que o mês atual

Editado Outubro 11, 2007 por Duduh_Capixaba

[kuroi]

legal, só q esse problema ainda continua:

se o cara nasce em 29/02/2004, quando chegar 29/02/2008 ele vai ter 4 anos, certo?? agora e em 2009?? feverero tem só 28 dias. então ele deveria ter 5 anos em 28/02/2009, certo?? so q a sua formula diz q ele teria só 4. e ele só faria 5 em 01/03/2009.

alias, não sei se é problema, agora to em duvida... quando o cara q nasceu em 29/02, quando for em ano q não é bissexto, q dia ele faz aniversario, é no 28/02 ou em 01/03?? se for 01/03, beleza, mas se for em 28/02, a sua funcao calcula errado nesse caso.

[Duduh_Capixaba]

Tenho uma prima que nasceu no dia 29/02, vou perguntar a ela como ela foi registrada. Mas tenho quase certeza que foi no dia 28. Sendo assim, a função funciona tranquilo, mas se for mesmo no dia 29, aí eu teria que acertar. Assim que der eu acerto, não é nada de tão difícil =] Vlw vlw!!!

Editado Outubro 15, 2007 por Duduh_Capixaba

[Duduh_Capixaba]

alias, não sei se é problema, agora to em duvida... quando o cara q nasceu em 29/02, quando for em ano q não é bissexto, q dia ele faz aniversario, é no 28/02 ou em 01/03?? se for 01/03, beleza, mas se for em 28/02, a sua funcao calcula errado nesse caso.

Kuroi, confirmei com minha prima, ela foi registrada no dia 28/02. Segundo meu código, ela teria 5 anos no dia 28/02/2009 se tivesse nascido no dia 28/02/2004. Mas mesmo assim, fiz um código para o caso do dia 29/02:

Dim DtNasc, DtAtual As Date
    Dim Idade As Integer
    
    DtNasc = CDate(MaskEdBox1.Text)
    DtAtual = CDate(Date)

    If Month(DtNasc) > Month(DtAtual) Then
        Idade = Year(DtAtual) - Year(DtNasc) - 1
    
    ElseIf Month(DtNasc) = Month(DtAtual) Then
        If Day(DtNasc) = 29 And Month(DtNasc) = 2 Then
            Idade = Year(DtAtual) - Year(DtNasc)
        ElseIf Day(DtNasc) > Day(DtAtual) Then
            Idade = Year(DtAtual) - Year(DtNasc) - 1
        Else
            Idade = Year(DtAtual) - Year(DtNasc)
        End If
    
    Else
        Idade = Year(DtAtual) - Year(DtNasc)
    End If
    
    If Idade < 0 Then Idade = 0
    Text1.Text = Idade

Testa aí e verifica se vai gerar algum erro. Aqui deu tudo certo, mas não testei todas as possibilidades ainda. Abraço!

Editado Outubro 16, 2007 por Duduh_Capixaba
Adicionar tag CODE

[kuroi]

opa, testei aqui, e o erro agora é diferente. se o cara nasce no dia 29/02, ele ta fazendo aniversario em 01/02.

tipo, se você setar a data atual pra qualquer dia de fevereiro já soma um ano a mais pra ele.

exemplo, se o cara nasceu em 29/02/2004 e hj é 01/02/2008, ta dando q ele tem 4 anos, mas ele só deveria ter 4 em 29/02/2008.

ve ai se você consegue resolver.

[Duduh_Capixaba]

hum, falha nostra...correção:

Dim DtNasc As Date, DtAtual As Date
    Dim Idade As Integer
    
    DtNasc = CDate(MaskEdBox1.Text)
    DtAtual = CDate(Date)

    If Month(DtNasc) > Month(DtAtual) Then
        Idade = Year(DtAtual) - Year(DtNasc) - 1
    
    ElseIf Month(DtNasc) = Month(DtAtual) Then
        If Day(DtNasc) = 29 And Month(DtNasc) = 2 And Day(DtAtual) >= 28 Then
            Idade = Year(DtAtual) - Year(DtNasc)
        ElseIf Day(DtNasc) > Day(DtAtual) Then
            Idade = Year(DtAtual) - Year(DtNasc) - 1
        Else
            Idade = Year(DtAtual) - Year(DtNasc)
        End If
    
    Else
        Idade = Year(DtAtual) - Year(DtNasc)
    End If
    
    If Idade < 0 Then Idade = 0
    Text1.Text = Idade

Editado Outubro 16, 2007 por Duduh_Capixaba

[kuroi]

parece q ta funcionando legal agora, mas tenho uma duvida aidna

Kuroi, confirmei com minha prima, ela foi registrada no dia 28/02. Segundo meu código, ela teria 5 anos no dia 28/02/2009 se tivesse nascido no dia 28/02/2004. Mas mesmo assim, fiz um código para o caso do dia 29/02:

beleza, ela teria 5 anos em 28/02/2009. agora e em 2008?? ela teria 4 anos em 28/02 ou só em 29/02?? porque olha, sua prima nasceu em 29/02, mas ela foi registrada em 28/02. mas acho q nem todo mundo é registrado assim.

pensa se o cara tiver acessando o programa. se for sua prima ela vai por q a data de nascimento dela é 28/02 (apesar de ser 29/02) por causa do registro. mas e se o cara foi registrado mesmo no dia 29?? ai ele vai e digita q nasceu no dia 29/02/2004. ele vai fazer 1 ano em 28/02/2005, vai fazer 2 anos em 28/02/2006, vai fazer 3 anos em 28/02/2007, mas e em 2008?? ele vai fazer 4 anos em 28/02/2008 ou em 29/02/2008??

[Duduh_Capixaba]

Hum...é verdade Kuroi, se o cara nasceu em 29/02, no ano bissexto ele só faria aniversário no dia 29 (eu acho). Minha solução foi criar uma variável (BISSEXTO) que identificasse os anos bissextos, veja:

Dim DtNasc As Date, DtAtual As Date
    Dim Bissexto As Date, Idade As Integer
    
    Bissexto = DateSerial(Year(Now), 2, 29)
    DtNasc = CDate(MaskEdBox1.Text)
    DtAtual = CDate(Date)

    'Caso o mês do nascimento seja maior que o mês atual
    If Month(DtNasc) > Month(DtAtual) Then
        Idade = Year(DtAtual) - Year(DtNasc) - 1
    
    'Caso o mês do nascimento seja igual ao mês atual
    ElseIf Month(DtNasc) = Month(DtAtual) Then
        If Day(DtNasc) = 29 And Month(DtNasc) = 2 And Day(DtAtual) >= 28 And Day(Bissexto) = 1 Then
            Idade = Year(DtAtual) - Year(DtNasc)
        ElseIf Day(DtNasc) > Day(DtAtual) Then
            Idade = Year(DtAtual) - Year(DtNasc) - 1
        Else
            Idade = Year(DtAtual) - Year(DtNasc)
        End If
    
    'Caso o mês do nascimento seja menor que o mês atual
    Else
        Idade = Year(DtAtual) - Year(DtNasc)
    End If
    
    If Idade < 0 Then Idade = 0
    Text1.Text = Idade

Se o valor do dia BISSEXTO for 29, então estamos em um ano bissexto, mas se for 01, é porque o ano não tem o dia 29. Sendo assim, a variável recebe o valor do próximo dia, no caso, 01/03. Refaça os testes.Creio que agora ficou certo. Vlw, abraço!

[kuroi]

opa, demorei mas testei aqui.

só fiz uma modificacao, na funcao. adicionei um segundo ElseIf quando o mes for igual pra testar quando for dia 29 e o cara tiver nascido no dia 28.

ai fiz os esquemas pra funcionar como uma Function e ficou tipo assim:

Public Function CalculaIdade(DtNasc As Date) As Integer
    Dim DtAtual As Date, Bissexto As Date
    Dim Idade As Integer
    
    DtAtual = CDate(Date)
    Bissexto = DateSerial(Year(DtAtual), 2, 29)

    'Caso o mês do nascimento seja maior que o mês atual
    If Month(DtNasc) > Month(DtAtual) Then
        Idade = Year(DtAtual) - Year(DtNasc) - 1
    
    'Caso o mês do nascimento seja igual ao mês atual
    ElseIf Month(DtNasc) = Month(DtAtual) Then
        If Day(DtNasc) = 29 And Month(DtNasc) = 2 And Day(DtAtual) >= 28 And Day(Bissexto) = 1 Then
            Idade = Year(DtAtual) - Year(DtNasc)
        ElseIf Day(DtAtual) = 29 And Month(DtAtual) = 2 And Day(DtNasc) < 29 And Day(Bissexto) = 1 Then
            Idade = Year(DtAtual) - Year(DtNasc) - 1
        ElseIf Day(DtNasc) > Day(DtAtual) Then
            Idade = Year(DtAtual) - Year(DtNasc) - 1
        Else
            Idade = Year(DtAtual) - Year(DtNasc)
        End If
    
    'Caso o mês do nascimento seja menor que o mês atual
    Else
        Idade = Year(DtAtual) - Year(DtNasc)
    End If
    
    If Idade < 0 Then Idade = 0
    CalculaIdade = Idade
End Function[/code]
parece q agora ta certinha, mas veja ai se você quer fazer algum teste ou modificacao e me avisa e q eu edito la o tópico. ou se você quiser você mesmo pode postar a sua funcao la como resposta.