[Resolvido] Data de nascimento

Boa tarde, gostaria de que me ajudassem.

Tenho o seguinte:



Gostaria de saber como que faço para que quando inserir a data de nascimento do paciente, ao lado deste item aparecer a idade dele, com ano, mes e dias. Então ficaria registrado a data de nascimento e ao lado a idade dele. E também como consultar a idade no relatorio.

Obrigado

Olá, seja bem vindo ao fórum!

Dê uma pesquisada que temos vários tópicos sobre o assunto. Inclusive tem exemplos no Repositório de Exemplos. Caso reste dúvidas quando à adaptação dos exemplos, poste aqui para que possamos avaliar.

Vi alguns exemplos e gostei muito, mas visto eu ser leigo no access, gostaria de saber em que locais eu altero no código.

Esse é aonde coloca a data de nascimento

Código:

Private Sub txtDataNascimento_AfterUpdate()
Me.txtIdadeSimples.Value = CalculaIdade(Me.txtDataNascimento) & " " & "Anos"
Me.txtIdadeCompleta.Value = AnoMesDia(Me.txtDataNascimento)
Me.txtIdadeSimples.Requery
Me.txtIdadeCompleta.Requery
End Sub

Resultado em dias, mes e anos:

Código:

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
 

  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

Resultado em anos:

Código:

Public Function CalculaIdade(VariavelA As Variant, Optional VariavelB As Variant) As Variant

    Dim DataA As Date
    Dim DataB As Date
    Dim DataC As Date
    Dim strSQl As String
    CalculaIdade = Null

    If IsDate(VariavelA) Then
        DataA = VariavelA

        If Not IsDate(VariavelB) Then
            DataB = Date
        Else
            DataB = VariavelB
        End If

        If DataB >= DataA Then
            DataC = DateSerial(Year(DataB), Month(DataA), Day(DataA))
            CalculaIdade = DateDiff("yyyy", DataA, DataB) + (DataC > DataB)
        End If
    End If
   
End Function

Não nego que é um excelente exemplo e se aplica a mim, mas aonde altera o no código para se encaixar ao meu formulário?

Tente utilizar a segunda função colocando o nome do campo da data de nascimento no lugar de dtData2.

Rapaz nao estou conseguindo, da uma olhada neste formulario.

Que nome coloca. certinho no codigo.

Você deve substituir dtData1 pelo nome do campo aonde está a data e AnoMesDia pelo nome do campo aonde a idade deve aparecer. Coloque esse código no evento "Após atualizar" do campo aonde irá digitar a data ou, para retornar a idade de registros já existentes, coloque no evento "No atual" do formulário, mas sem a primeira e a última linhas do código, pois, você está tirando os códigos da função e colocando em um evento. Por isso, mude tambem a linha Exit Function para Exit Sub.

Da uma olhada no código. Ve se tem algo errado, pq nao to conseguindo.

Código:

Public Function Idade(Data_de_nascimento As Date) As String
On Error GoTo Idade_Err

  Dim sTmp As String
  Dim nDMA As Long
  Dim NewDate As Date
  Dim sSngPlural As String
  Dim dtData2 As Date
 

  dtData2 = Now
 
  ' Bloco Ano ---------------------
  ' Calcula número inteiro de anos
  nDMA = DateDiff("yyyy", Data_de_nascimento, dtData2)
  ' Se Data1+nDMA>Data2, subtrai 1 ano
  If DateAdd("yyyy", nDMA, Data_de_nascimento) > 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, Data_de_nascimento)
  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
  Idade = sTmp
 
Idade_Fim:
  Exit Function
Idade_Err:
  MsgBox Err.Description
  Resume Idade_Fim
End Function

Leia meu post anterior com atenção. Faltou umas adaptações que eu mencionei nele.

Voce falou que "Você deve substituir dtData1 pelo nome do campo aonde está a data" e tbm "colocando o nome do campo da data de nascimento no lugar de dtData2." SUbstituio os dois pelo Data_do_nascimento?

Falei tambem:

... Coloque esse código no evento "Após atualizar" do campo aonde irá digitar a data ou, para retornar a idade de registros já existentes, coloque no evento "No atual" do formulário, mas sem a primeira e a última linhas do código, pois, você está tirando os códigos da função e colocando em um evento. Por isso, mude tambem a linha Exit Function para Exit Sub.

Pior ne! Deletei a ultima linha e primeira que fala function e alterei, mas mesmo assim nao da, ficou assim.

Código:

On Error GoTo Idade_Err

  Dim sTmp As String
  Dim nDMA As Long
  Dim NewDate As Date
  Dim sSngPlural As String
  Dim dtData2 As Date
 

  dtData2 = Now
 
  ' Bloco Ano ---------------------
  ' Calcula número inteiro de anos
  nDMA = DateDiff("yyyy", dtData_de_nascimento, dtData2)
  ' Se Data_de_nascimento+nDMA>Data2, subtrai 1 ano
  If DateAdd("yyyy", nDMA, dtData_de_nascimento) > 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, dtData_de_nascimento)
  nDMA = DateDiff("m", NewDate, dtData2)
  ' Se Data_de_nascimento+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
  Idade = sTmp
 
Idade_Fim:
  Exit Sub
Idade_Err:
  MsgBox Err.Description
  Resume Idade_Fim


Eu testei aqui da forma que falei acima e funcionou. Você colocou no evento certo?

Pior q sim

Amigo boa tarde

veja um exemplo que criei para você!

http://speedy.sh/RRCqg/CalculoIdadeSander.zip

Lembrando que este código é do mestre J.Paulo

Ele vai para o depurador, e mostra em enfase a que esta em amarelo.
Me.Idade.Value = AnoMesDia(Me.Ano_de_nascimento)

Código:

Option Compare Database

Private Sub Ano_de_nascimento_AfterUpdate()
Me.Idade.Value = AnoMesDia(Me.Ano_de_nascimento)
Me.Idade.Requery
End Sub
Private Sub Form_Load()
 DoCmd.GoToRecord , "", acNewRec
End Sub

Atenção nos nomes dos campos.


Tabela:
Nome dos campos:

DataNascimento
IdadeCompleta

Após atualizar do campo "DataNacimento"

Private Sub DataNascimento_AfterUpdate()
Me.IdadeCompleta.Value = AnoMesDia(Me.DataNascimento)
Me.IdadeCompleta.Requery
End Sub


Não tem erro!

Não esqueça do módulo


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


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

Os nomes fiz a alteracao de acordo com o meu banco de dados, ja a respeito do modulo fiz tbm.

deem uma olhada

http://speedy.sh/bbSgH/Banco-de-Dados2.accdb

Veja seu banco funcionando!

http://speedy.sh/JJXNY/BDmodificado.zip

criei um novo campo na sua tabela

DataNascimento:.......................defini dados do campo como "Data"
Idade:................................defini dados co campo como "Texto"



Muito cuidado com acentos nos campos de tabela, melhor evitar
acentos e espaços.


Está funcionando normal, não se esqueça de clicar em resolvido
se deu certo o que pretende.

um abraço.

Excluido

kkkk, resolvido!! MUITO OBRIGADO!!!

Agora vem outra, hehehehe

Gostaria de colocar botao de opcao, mas ja add o nome na tabela, e coloquei no formulario, mas quando vou no alterar para... nao tem a opcao BOTAO DE OPCAO. Tem um outro meio?

Fiz uma modificação veja de novo:




http://speedy.sh/ssePC/BD-SANDER.zip




Agora vai funfar lembrando que vc tem que cadastrar
novamente as pessoas pois é calculada a idade
no evento após atualizar, após apertar "Enter"

tambem modifiquei a caixa de combinação..
ao entrar ela expandir.

mas se resolveu não esqueça do resolvido.

BLz MUITO OBRIGADO!!!

Ate a proxima

clique no resolvido, o tópico ainda está em aberto.

Valeu!