[Resolvido]Operações com datas.

Gente bom dia!!!

Eu observei aqui no Forum o ótimo código abaixo que o nosso querido JPaulo nos disponibilizou:

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 = #3/31/2012#
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

Onde está em vermelho era Date(), e eu coloquei até 31/03/2012 para que as datas se modifiquem até esta data, ou seja, se a criança nasceu antes de março no ano de 2007 por exemplo teria 5 anos, e depois de março desse mesmo ano teria 4 anos na data atual. A questão é:
Eu usaria este mesmo critério para todas as crianças que completam qualquer ano no ano de 2012 com exceção de 6 anos que eu queria que mudasse no dia 31/07/2012... Seria possivel trabalhar essa idéia nesse mesmo código?
Desde já agradeço muito a atenção de todos vocês... Bjs

Bem... eu confesso que não entendi muito bem...

De um exemplo prático do que pretende..

Cumprimentos.

Oi Piloto tudo bem...

Meu querido a situação é:

Eu tenho uma caixa de texto onde eu insiro a data de nascimento da criança, e quando eu informou a data de nascimento dessa criança, se ela nasceu por exemplo no dia 09/02/2007 ela vai se encaixar nas turmas de 05 anos haja visto ela tem 05 anos de idade completos até o dia 31/03/2012. Se essa criança tivesse nascido no dia 09/06 do mesmo ano por exemplo, ela iria se encaixar nas turmas de 04 anos, pois até o dia 31/03/2012 essa criança estava com 04 anos e só vai fazer aniversário no mês de junho que é após o dia 31/03/2012. Isso o código acima já faz pra mim, só que a questão é que eu queria que as crianças que fosse completar 06 anos no ano corrente o critério adotado seria ao invés de 31/03 fosse 31/07 e os demais consinuasse no dia 31/03/2012. Exemplo: A criança que nasceu no dia 09/06/2006 ela vai completar 06 anos até o dia 31/07, ela seria encaixada na turma de 06 anos. Após essa data turmas de 05 anos...

Eu queria ver a possibilidade de trabalhar isso no mesmo código acima... Será que tem jeito...
Eu vou disponibilizar meu BD pra vc entender melhor tá... Desde já te agradeço muuuuuuuuuito... Bjs

http://speedy.sh/RZC9g/Datas.mdb

Bem... Após atualizar sua Data, se o resultado for 6 remete para o case correspondente e dá menssagem de erro contida no case.


Seria algo assim no 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
Dim NovoCriterio as Bolean
'Se a variável NovoCritério estiver definida como True, vai para o rótulo Redefine, isso posto que a função é repetida quando se digita a data no form

If NovoCriterio = True Then GoTo Redefine
If IsDate(VariavelA) Then
DataA = VariavelA

If Not IsDate(VariavelB) Then
DataB = #3/31/2012#
Else
DataB = VariavelB
End If

If DataB >= DataA Then
DataC = DateSerial(Year(DataB), Month(DataA), Day(DataA))
CalculaIdade = DateDiff("yyyy", DataA, DataB) + (DataC > DataB)
If CalculaIdade = 6 Then GoTo Redefine
End If
End If
Exit Function
'=====================================================================================
Redefine:
' Redefine a DataB
If IsDate(VariavelA) Then
DataA = VariavelA

If Not IsDate(VariavelB) Then
DataB = #7/31/2012#
Else
DataB = VariavelB
End If

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

Cumprimentos.

Para que a variável NovoCritério seja definida como True e não seja limpa ao final do código:



Option Compare Database
Option Explicit
Public NovoCriterio As Boolean

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
Dim StrData As Date
'Caso seja a idade 6 anos, vai para redefinir a dataB
If NovoCriterio = True Then GoTo Redefine
If IsDate(VariavelA) Then
DataA = VariavelA

If Not IsDate(VariavelB) Then
DataB = #3/31/2012#
Else
DataB = VariavelB
End If

If DataB >= DataA Then
DataC = DateSerial(Year(DataB), Month(DataA), Day(DataA))
CalculaIdade = DateDiff("yyyy", DataA, DataB) + (DataC > DataB)
If CalculaIdade = 6 Then GoTo Redefine
End If
End If
Exit Function
'=====================================================================================
Redefine:
' Redefine a DataB
If IsDate(VariavelA) Then
DataA = VariavelA

If Not IsDate(VariavelB) Then
DataB = #7/31/2012#
Else
DataB = VariavelB
End If

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


E para limpar a variável, no case 6:

Case Is >= "6 Anos"
Me.AnoEstudo = ""
Me.AnoEstudo.Visible = False
Me.Turma.Visible = False
Me.Turno.Visible = False
Me.TxtIdade.Visible = False
Beep
MsgBox "Esta criança não está na faixa etária para o atual atendimento", vbCritical
Me.DataNascimento = Null
Me.DataNascimento.SetFocus
NovoCriterio = ""
End Select

Boa tarde meu querido...

Me perdoe meu equívoco horrivel que cometi... Na verdade eu estive observado que disponibilizei um BD que estava aberto somente para educação infantil(3, 4 e 5 anos) e estava fechado para 6 anos.
Eu fiz um teste aqui e queria entender melhor sua opnião... Eu tenho que abrir dois módulo é isso? Eu faço essa pergunta por que no código acima está Option Explicit nos dois códigos...

Grata...

Você quer mudar esse critério:
DataB = #3/31/2012#

Caso tenha 6 anos correto..

Então... Faz a primeira checagem...

Se tiver 6 anos... remete para uma função igual, porem com o outro critério..
Eu observei que ao colocar a data no form, ele executa por duas vezes a mesma função...
Por isso eu criei a variável NovoCriterio e ao final da segunda função defino a mesma como True, sendo assim ao retornar para
o inicio da função e a mesma estiver como True.. vai novamente para a segunda função.


Compreendeu?


Cumprimentos.

é no mesmo módulo... apenas coloquei ai para ver que a variável pública fica nas declarações do módulo e não da função.


Cumprimentos.

Querido boa tarde...

Ele faz a atualização mas não volta ao critério de 31/03 e continua 31/07. Não sei o que está acontecendo...
Uma outra observação é que no critério da turma onde dá 06 anos diz dá msg de erro dizendo que esta criança não está na faixa estária de atendimento e faz com que todas as caixas de ano de estudo(ano de estudo, turma, turno e idade) fosse desconsiderado, haja vista que minha intenção é dar continuidade nos anos de estudos sem limite como está no BD limitando até as turmas de 05 anos... Desde já te agradeço muito pela atenção... bjs

No FOrm.. você tem que colocar a linha que limpa a Variável NovoCriterio...

Assim..

Chama a função pelo Form...
NovoCriterio = ""


A função é executada no Modulo...
depois na continuação ela é limpa...

Boa noite Piloto... Desculpa a demora...

Olha só o erro que dá

Envie o BD ja com esta modificação.

Cumprimentos.

Olá meu querido, desculpa a demora, segue em anexo o bd... bjs

http://speedy.sh/YzwCG/Datas.mdb

Boa tarde Maria José, perdoe-me o equivoco, a variável NovoCriterio é do tipo Boolean (Verdeiro/Falso) portanto não pode ser limpa e sim alterada.

No form onde coloquei a instrução mude para: NovoCriterio = False

No Módulo substitua:


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
Dim StrData As Date
'Caso seja a idade 6 anos, vai para redefinir a dataB
If NovoCriterio = True Then GoTo Redefine
If IsDate(VariavelA) Then
DataA = VariavelA

If Not IsDate(VariavelB) Then
DataB = #3/31/2012#
Else
DataB = VariavelB
End If

If DataB >= DataA Then
DataC = DateSerial(Year(DataB), Month(DataA), Day(DataA))
CalculaIdade = DateDiff("yyyy", DataA, DataB) + (DataC > DataB)
If CalculaIdade >= 6 Then GoTo Redefine
End If
End If
Exit Function
'=====================================================================================
Redefine:
' Redefine a DataB
If IsDate(VariavelA) Then
DataA = VariavelA

If Not IsDate(VariavelB) Then
DataB = #7/31/2012#
Else
DataB = VariavelB
End If

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


Alterei a checagem para Maior ou igual a 6


Cumprimentos

Bom diaaaaaa...

Piloto muuuuuuuuuuuito obrigado pela sua preciosa ajuda... Estou muito grata pela ótima dica... Deu certissimo... Espero que um dia eu possa ter esses conhecimentos que vcs tem, estou me esforçando...

Bjs

Fico feliz que deu certo.

O Fórum agradece o retorno.