[Resolvido]Erro ao gerar série em intervalo de data de nascimento

Gente boa nooite a todos...

Pra entender melhor eu coloquei o link abaixo pra que vcs possam acompanhar a trajetória desse feito maravolhoso que terminou no nosso querido PILOTO..

É o seguinte: eu não sei como fazer com a situação que está acontecendo no meu BD, e observei que quando eu coloco uma data de nascimento ele faz o calculo certinho, só que após ter colocado a data de nascimento e ja ter gerado a série na caixa "ano de estudo" e eu desistir por ter errado a data de nascimento, quando digito novamente outra data de nascimento que não esteja entre 02 e 07 ele repete o ultimo ano de estudo calculado na caixa "ano de estudo". Exemplo:

Digito a data de nascimento: 17/06/2008 vai ser Pré I na caixa ano de estudo, só que se eu antes de ter salvo o dado eu quero mudar a data de nascimento para 17/06/2000 ele continua Pré I ao invés de limpar e ativar a caixa "ano de estudo" para que eu escolha a série.

Eu já tentei na seguinte forma:
No campo "DataNascimento" no evento antes de atualizar eu coloquei após o case "7 Ano" o seguinte:

Case Is > "8 Anos"
Me.AnoEstudo.Enabled = True
Me.AnoEstudo = ""

só que continua a mesma série na caixa "ano de estudo".

Alguém tem uma opnião? Desde já eu agradeço o apoio de todos...

Bessitos

http://maximoaccess.forumeiros.com/t10094-resolvidoadequacao-em-datas

Boa noite, Maria José
O ano de estudo é escolhido independente da data de nascimento, ou não?

Olá alexandre...

Na verdade é o seguinte: o ano de estudo é independente da data de nascimento conforme elencado abaixo. Quando ele faz o calculo entre 02 e 07 anos beleza, ele funciona bacana. Mas quando ele faz o calculo que dá entre 02 e 07 anso e depois faz novamente outro calculo acima de 07 ele repete o ultimo ano de estudo calculado. Já pensei na forma que está em vermelho mas não dah... Bjs

On Error GoTo 1

Dim Rs As DAO.Recordset
Dim Msg As String

Set Rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Intervalo_Data ;")

Do While Not Rs.EOF

If Me.DataNascimento >= Rs!DataInicial And Me.DataNascimento <= Rs!DataFinal Then
Me.txtdata.Value = CalculaIdade(Me.DataNascimento, Rs!criterio) & "" & " anos"
Exit Do
End If
Rs.MoveNext
Loop

Me.txtdata.Requery

Select Case Me.txtdata

Case "0 Anos"

If MsgBox("Esta criança completará 06 anos até o dia 31/07 do corrente ano. Deseja cadastrá-la no 1º ano?", vbExclamation + vbYesNo, "") = vbYes Then

Me.AnoEstudo = "1º ano"

Else

Me.AnoEstudo = "Pré II"

If MsgBox("Deseja imprimir o termo de responsabilidade?", vbExclamation + vbYesNo, "") = vbYes Then
DoCmd.OpenReport "TermodeResponsabilidade", acViewPreview, , , acDialog
DoCmd.Maximize
Else
End If
End If

Case "2 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "Creche II"

Case "3 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "Creche III"

Case "4 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "Pré I"

Case "5 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "Pré II"

Case "6 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "1º Ano"

Case "7 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "2º Ano"

Case Is > "8 Ano"
Me.AnoEstudo.Enabled = True
Me.AnoEstudo = ""

End Select

Rs.Close
Set Rs = Nothing

Se esta última condição abrange todas as situações que não couberam nas condições anteriores, coloque
Case else
Me.AnoEstudo.Enabled = True
Me.AnoEstudo = ""
bjs

Olá alexadre...

Mas alexandre onde fica a condição de que "se não estiver dentro do intervalo de 02 a 07?"

bjs

Fica onde está a vermelho
a condição é verificada pelo select case e executa o código onde seja verdadeira a condição. O código do Case Else (senão) é executado quando aqui chegar. ora, só chega aqui se não tiver obedecido a nenhum dos critérios anteriores
bjs

Alexandre BOa noite...

Euu ainda não tive exito!!! Pois quando dar acima de 08 anos não limpa e ativa a caixa ano de estudo... Não sei o que está acontecendo...

bjs

Coloquei assim
Private Sub DataNascimento_AfterUpdate()
On Error GoTo 1

Dim Rs As DAO.Recordset
Dim Msg As String


Set Rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Intervalo_Data ;")

Do While Not Rs.EOF

If Me.DataNascimento >= Rs!DataInicial And Me.DataNascimento <= Rs!DataFinal Then
Me.txtdata.Value = CalculaIdade(Me.DataNascimento, Rs!Criterio) & "" & " anos"
Exit Do
End If
Rs.MoveNext
Loop

Me.txtdata.Requery

Select Case Me.txtdata

Case "2 Anos"
Me.AnoEstudo = "Creche II"

Case "3 Anos"
Me.AnoEstudo = "Creche III"

Case "4 Anos"
Me.AnoEstudo = "Pré I"

Case "5 Anos"
Me.AnoEstudo = "Pré II"

Case "6 Anos"
Me.AnoEstudo = "1º Ano"

Case "7 Anos"
Me.AnoEstudo = "2º Ano"
Case Else
Me.AnoEstudo.Enabled = True
Me.AnoEstudo = ""
End Select
Rs.Close
Set Rs = Nothing

Exit_1:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub

1 A:
DoCmd.Hourglass False
DoCmd.Echo True
Msg = "Erro # " & Str(Err.Number) & " gerado na " & Err.Source _
& vbNewLine & vbNewLine & "Descrição: " & Err.Description _
& vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
MsgBox Msg, vbMsgBoxHelpButton + vbCritical, "Erro", Err.HelpFile, Err.HelpContext
Resume Exit_1
End Sub

bjs

Alexandre me desculpa querido mas acho que não to conseguindo...

Quando eu insiro uma data que esteja dentro do intervalo 02 e 07 e adiciono blz. Mas logo em seguida se eu inserir uma nova data que não esteja dentro do intervalo de 02 a 07 ele repete o ultimo ano de estudo ao invés de limpar e ativa a caixa ano de estudo...
Detalhe: Isso só acontece se não estiver dentro do intervalo de 02 a 07 anos.

Teste: Adiciona uma criança com idade de 18/07/2008 e logo em seguida clica no botão adicionar e adicionar um novo registro com idade de 20/02/2000 ele vai repetir o Pré I ao invés ativar a caixa de ano de estudo.

Bjs adorei essa cabeleira... rsrsrsrsrs

http://speedy.sh/dfPN9/Teste.accdb

Bom dia, Maria José
Nomeie os controlos de forma normalizada. Ajuda quer ao sistema quer a quem trabalha com o código.
Essa data do ano 2000 está fora dos parâmetros da tabela.
Coloca assim

On Error GoTo 1

Dim Rs As DAO.Recordset
Dim Msg As String

Me.AnoEstudo.Enabled = True
Me.AnoEstudo = ""

Set Rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Intervalo_Data ;")
Rs.MoveFirst
Do While Not Rs.EOF

If Me.DataNascimento >= Rs!DataInicial And Me.DataNascimento <= Rs!DataFinal Then
Me.txtdata.Value = CalculaIdade(Me.DataNascimento, Rs!criterio) & "" & " anos"
Exit Do
End If
Rs.MoveNext
Loop

Me.txtdata.Requery

Select Case Me.txtdata

Case "0 Anos"

If MsgBox("Esta criança completará 06 anos até o dia 31/07 do corrente ano. Deseja cadastrá-la no 1º ano?", vbExclamation + vbYesNo, "") = vbYes Then

Me.AnoEstudo = "1º ano"

Else

Me.AnoEstudo = "Pré II"

If MsgBox("Deseja imprimir o termo de responsabilidade?", vbExclamation + vbYesNo, "") = vbYes Then
DoCmd.OpenReport "TermodeResponsabilidade", acViewPreview, , , acDialog
DoCmd.Maximize
Else
End If
End If

Case "2 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "Creche II"

Case "3 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "Creche III"

Case "4 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "Pré I"

Case "5 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "Pré II"

Case "6 Anos"
Me.AnoEstudo.Enabled = False
Me.AnoEstudo = "1º Ano"

Case "7 Anos"
Me.AnoEstudo = "2º Ano"
End Select
Rs.Close
Set Rs = Nothing

Exit_1:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub

1 A:
DoCmd.Hourglass False
DoCmd.Echo True
Msg = "Erro # " & Str(Err.Number) & " gerado na " & Err.Source _
& vbNewLine & vbNewLine & "Descrição: " & Err.Description _
& vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
MsgBox Msg, vbMsgBoxHelpButton + vbCritical, "Erro", Err.HelpFile, Err.HelpContext
Resume Exit_1

bjs

Alexandre me perdoa...

Eu fiz como me disse e ainda não deu... Não sei o que está acontecendo... Acredito que deva ser questão de zerar calculo, pois pelo que parece ele repete o ultimo calculo se não estiver dentro do parâmetro (02 a 07 ano)... Eu to tentando achar onde é mas não to conseguindo...

Brigadão querido... bjs

Boa noite alexandre...

Querido eu consegui ver uma maneira que resolva o meu problema. É o seguinte:

Eu acrescentei na tabela tbl_Intervalo_Data a seguinte data: coloquei o intervalo de 01/04/1982 a 31/03/2005 e no evento ao atualizar eu coloquei o código abaixo:

Case ""
Me.AnoEstudo.Enabled = True
Me.AnoEstudo = ""

Deu perfeito. Só que eu não sei as regras do forum permite mas eu queria ver se há a possibilidade de alguma maneira do proprio sistema atualizar as datas da tabela conforme a necessidade da consulta.. Exemplo:

Nos estamos no ano de 2013 então seria da seguinte forma:

No critério da tabela tbl_Intervalo_Data seria de 01/04/2005 à 31/03/2006 com critério 31/03/2013

se fosse ano de 2014 seria da seguinte forma:

No critério da tabela tbl_Intervalo_Data seria de 01/04/2006 à 31/03/2007 com critério 31/03/2014

Desde já agradeço muito se apoio querido... bjs

Olá, Maria José
1 - Nomeie os controlos de forma normalizada (já deve ter visto muitas chamadas de atenção para as vantagens)
2 - Elimine a tabela das datas
3 - Código para DataNascimento
Private Sub DataNascimento_AfterUpdate()
On Error GoTo 1

Dim Msg As String

Me.AnoEstudo = strAnoEstudo(Me.DataNascimento)
Exit_1:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub

1 A:
DoCmd.Hourglass False
DoCmd.Echo True
Msg = "Erro # " & Str(Err.Number) & " gerado na " & Err.Source _
& vbNewLine & vbNewLine & "Descrição: " & Err.Description _
& vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
MsgBox Msg, vbMsgBoxHelpButton + vbCritical, "Erro", Err.HelpFile, Err.HelpContext
Resume Exit_1
End Sub

4 - função que lhe criei:
Function strAnoEstudo(DataNascimento As Date) As String
'função criada por Alexandre Neves, do Fórum MaximoAccess
'em 2013-02-03 para Maria José Soares
'a função pode ser utilizada livremente, desde que mencionado este cabeçalho
If DataNascimento > DateSerial(Year(Date) - 8, 4, 1) And DataNascimento < DateSerial(Year(Date) - 7, 3, 31) Then
strAnoEstudo = "2º Ano"
ElseIf DataNascimento > DateSerial(Year(Date) - 7, 4, 1) And DataNascimento < DateSerial(Year(Date) - 6, 7, 31) Then
strAnoEstudo = "1º Ano"
ElseIf DataNascimento > DateSerial(Year(Date) - 6, 8, 1) And DataNascimento < DateSerial(Year(Date) - 5, 3, 31) Then
strAnoEstudo = "Pré II"
ElseIf DataNascimento > DateSerial(Year(Date) - 5, 4, 1) And DataNascimento < DateSerial(Year(Date) - 4, 3, 31) Then
strAnoEstudo = "Pré I"
ElseIf DataNascimento > DateSerial(Year(Date) - 4, 4, 1) And DataNascimento < DateSerial(Year(Date) - 3, 3, 31) Then
strAnoEstudo = "Creche III"
ElseIf DataNascimento > DateSerial(Year(Date) - 3, 4, 1) And DataNascimento < DateSerial(Year(Date) - 2, 3, 31) Then
strAnoEstudo = "Creche II"
End If
End Function

bjs

Alexandre Bom dia...

Ótimo!!! Muito bom mesmo... Só que eu to com dúvida onde eu posso colocar aquela mensagem de opção para crianças que completam 06 anos até 31/07 se vão para o 1º ano ou se permaneçe no Pré II. E se permaneçer opção de imprimir ou não o termo de responsabilidade... Onde eu posso colocar essa mensagem??

Bjs

Maria José,
Veja as opções das idades e diga se estão contempladas todas as possibilidades
Qual mensagem? Não estou a ver.
bjs

Ok estão dentro das possibilidades... Só que faltaram as mensagens.. Mas eu vou ver o que eu consigo fazer e qualquer coisa eu retorno tah... bjs

Alexandre olha, vcs são maravilhosos... A cada dica, orientações, apoio e ajuda disponibilizado por vcs faz com que eu me fascine mais ainda por essa ferramenta... E a cada passo é uma nova novidade que surge... Eu quero te agraçer querido por mais essa contribuição... Valeu masmo... No código abaixo só acrescentei a mensagem do critério que te falei(31/07 = 06 anos)... Mas ficou maravilha viu... Valeu querido... Um grande abraço a vc...

Bjs

Function strAnoEstudo(DataNascimento As Date) As String
'função criada por Alexandre Neves, do Fórum MaximoAccess
'em 2013-02-03 para Maria José Soares
'a função pode ser utilizada livremente, desde que mencionado este cabeçalho
If DataNascimento > DateSerial(Year(Date) - 8, 4, 1) And DataNascimento < DateSerial(Year(Date) - 7, 3, 31) Then
strAnoEstudo = "2º Ano"

ElseIf DataNascimento > DateSerial(Year(Date) - 7, 4, 1) And DataNascimento < DateSerial(Year(Date) - 6, 3, 31) Then
strAnoEstudo = "1º Ano"

ElseIf DataNascimento > DateSerial(Year(Date) - 6, 4, 1) And DataNascimento < DateSerial(Year(Date) - 6, 7, 31) Then

If MsgBox("Esta criança completará 06 anos até o dia 31/07 do corrente ano. Deseja cadastrá-la no 1º ano?", vbExclamation + vbYesNo, "") = vbYes Then

strAnoEstudo = "1º Ano"

Else

strAnoEstudo = "Pré II"

If MsgBox("Deseja imprimir o termo de responsabilidade?", vbExclamation + vbYesNo, "") = vbYes Then
DoCmd.OpenReport "TermodeResponsabilidade", acViewPreview, , , acDialog
Else
End If
End If

ElseIf DataNascimento > DateSerial(Year(Date) - 6, 8, 1) And DataNascimento < DateSerial(Year(Date) - 5, 3, 31) Then
strAnoEstudo = "Pré II"
ElseIf DataNascimento > DateSerial(Year(Date) - 5, 4, 1) And DataNascimento < DateSerial(Year(Date) - 4, 3, 31) Then
strAnoEstudo = "Pré I"
ElseIf DataNascimento > DateSerial(Year(Date) - 4, 4, 1) And DataNascimento < DateSerial(Year(Date) - 3, 3, 31) Then
strAnoEstudo = "Creche III"
ElseIf DataNascimento > DateSerial(Year(Date) - 3, 4, 1) And DataNascimento < DateSerial(Year(Date) - 2, 3, 31) Then
strAnoEstudo = "Creche II"
End If
End Function

Maria José,
Ficamos sempre felizes quando podemos ajudar os outros. Mais felizes, quando nos agradecem com carinho para nos dar força.
Se está resolvido, devia ter premido o botão "Resolvido"
Agora, já marquei


bjs

Caro alexandre... Acho que vou começar a fazer um "Print Screen" ou usar a "Ferramenta de Captura" pra postar meu resolvido... Pois já eh a terçeira vez que isso aconteçe.. Eu clico em resolvido e me chamam a atenção que não cliquei em Resolvido... E dessa vez ainda foi pior pois quando eu sai cliquie e me certifiquei que estava Resolvido... Mas tb bem... Valeu... Abraços...

Maria José,
Não duvidamos da palavra dos membros. Acontece frequentemente esquecerem-se, não saberem como dar por resolvido ou, em vez de premirem o botão, alteram o título e incluem a palavra Resolvido.
Nisto, como noutras situações, por causa de uns pagam outros.
Não leve a mal e creia que acreditamos na sua palavra.
bjs