MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


+2
Alexandre Neves
michel_sys
6 participantes

    [Resolvido] Calcular idade exata com DifData

    michel_sys
    michel_sys
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 31
    Registrado : 07/06/2010

    [Resolvido] Calcular idade exata com DifData Empty [Resolvido] Calcular idade exata com DifData

    Mensagem  michel_sys 5/8/2010, 03:38

    Salve galera, cheers

    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! Very Happy
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8498
    Registrado : 05/11/2009

    [Resolvido] Calcular idade exata com DifData Empty Re: [Resolvido] Calcular idade exata com DifData

    Mensagem  Alexandre Neves 5/8/2010, 07:12

    Bom dia,

    Procure no fórum pela função CalculaIdade
    avatar
    Convidado
    Convidado


    [Resolvido] Calcular idade exata com DifData Empty Re: [Resolvido] Calcular idade exata com DifData

    Mensagem  Convidado 5/8/2010, 12:18

    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.
    vieirasoft
    vieirasoft
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7304
    Registrado : 11/05/2010

    [Resolvido] Calcular idade exata com DifData Empty Re: [Resolvido] Calcular idade exata com DifData

    Mensagem  vieirasoft 5/8/2010, 12:55

    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
    criquio
    criquio
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 11229
    Registrado : 30/12/2009

    [Resolvido] Calcular idade exata com DifData Empty Re: [Resolvido] Calcular idade exata com DifData

    Mensagem  criquio 5/8/2010, 13:00

    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.


    Última edição por criquio em 6/8/2010, 00:24, editado 1 vez(es)


    .................................................................................
    Meu novo site: www.vcssistemas.com.br

    Clique aqui e veja um vídeo que explica como fazer pesquisas no forum.


    DICA: Quando precisar inserir um exemplo do seu aplicativo, siga os procedimentos abaixo:
    1 - faça uma cópia do aplicativo
    2 - retire tudo que não for necessário à solução do problema, exceto o que o aplicativo precisar para funcionar
    3 - use o Compactar/Reparar
    4 - compacte o aplicativo em zip ou rar (zip para postagem como anexo na mensagem)


    Agradeça a quem lhe ajudou, clicando no joinha de uma das mensagens do usuário.
    Positive as mensagens que achar útil, no canto superior direito delas.

    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11026
    Registrado : 04/11/2009

    [Resolvido] Calcular idade exata com DifData Empty Re: [Resolvido] Calcular idade exata com DifData

    Mensagem  JPaulo 5/8/2010, 15:28

    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




    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido] Calcular idade exata com DifData Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido] Calcular idade exata com DifData Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido] Calcular idade exata com DifData Folder_announce_new Instruções SQL como utilizar...
    michel_sys
    michel_sys
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 31
    Registrado : 07/06/2010

    [Resolvido] Calcular idade exata com DifData Empty Re: [Resolvido] Calcular idade exata com DifData

    Mensagem  michel_sys 5/8/2010, 21:55

    boa noite, pessoal. Very Happy

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


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 14
    Registrado : 16/08/2011

    [Resolvido] Calcular idade exata com DifData Empty ADAPTANDO CÓDIGO IDADE

    Mensagem  Ennard 16/12/2013, 14:39

    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.

    Conteúdo patrocinado


    [Resolvido] Calcular idade exata com DifData Empty Re: [Resolvido] Calcular idade exata com DifData

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 22/11/2024, 04:47