[Resolvido]Interrupção de cálculo de tempo num formulário

Boa tarde,

Tenho num formulário dois campos de datas ("TxtInicioTrat" e "TxtFimTrat" que utilizo para referenciar o Início de Tratamento de um utente e o outro o Fim do Tratamento, e como são tratamentos longos criei um campo desacoplado que me dá o tempo de tratamento (anos, meses e dias) de cada utente através de um módulo que foi criado para esse efeito. O que pretendo, e não sei como resolver, é que quando o campo "TxtFimTratamento" for preenchido e ele só é preenchido quando o utente tem alta médica o campo desacoplado que tem o calculo de tempo de tratamento pare de contar o tempo daquele utente. O que acontece agora é que utentes que já pararam o tratamento continua a contar o tempo.
O módulo tem a seguinte programação:

Código:

Public Function CalcularTempTrat(ByVal TxtInicioTrat As Date) As String

Dim vCalcularAno As Double

Dim vCalcularMes As Double

Dim vCalcularDia As Double

Dim TxtDataActual As Date

Dim temp As Date


If IsNull(TxtInicioTrat) Then

   CalcularTempTrat = ""

   Exit Function

End If

TxtDataActual = Date


If TxtInicioTrat > TxtDataActual Then

   temp = TxtInicioTrat

  TxtInicioTrat = TxtDataActual

  TxtDataActual = temp

ElseIf TxtInicioTrat = TxtDataActual Then

   CalcularTempTrat = "0 días"

   Exit Function

End If


If Month(TxtInicioTrat) > Month(TxtDataActual) Then

   vCalcularAno = DateDiff("yyyy", TxtInicioTrat, TxtDataActual) - 1

Else

   vCalcularAno = DateDiff("yyyy", TxtInicioTrat, TxtDataActual)

End If


If Day(TxtInicioTrat) > Day(TxtDataActual) Then

   vCalcularMes = DateDiff("m", DateAdd("yyyy", vCalcularAno, TxtInicioTrat), TxtDataActual) - 1

   If vCalcularMes < 0 Then

       vCalcularMes = 12 + vCalcularMes

       vCalcularAno = vCalcularAno - 1

   End If

Else

   vCalcularMes = DateDiff("m", DateAdd("yyyy", vCalcularAno, TxtInicioTrat), TxtDataActual)

End If

vCalcularDia = DateDiff("d", DateAdd("m", vCalcularAno * 12 + vCalcularMes, TxtInicioTrat), TxtDataActual)

'Esta é a base do cálculo

If vCalcularAno = 1 Then

   CalcularTempTrat = vCalcularAno & " ano"

ElseIf vCalcularAno > 1 Then

   CalcularTempTrat = vCalcularAno & " anos"

End If

If vCalcularMes = 1 Then

   CalcularTempTrat = IIf(CalcularTempTrat = "", "", CalcularTempTrat & " * ") & vCalcularMes & " mes"

ElseIf vCalcularMes > 1 Then

   CalcularTempTrat = IIf(CalcularTempTrat = "", "", CalcularTempTrat & " * ") & vCalcularMes & " meses"

End If

If vCalcularDia = 1 Then

   CalcularTempTrat = IIf(CalcularTempTrat = "", "", CalcularTempTrat & " * ") & vCalcularDia & " día"

ElseIf vCalcularDia > 1 Then

   CalcularTempTrat = IIf(CalcularTempTrat = "", "", CalcularTempTrat & " * ") & vCalcularDia & " días"

End If

End Function


Cumprimentos

Boa tarde,

Alguém do forum que me possa ajudar nesta dúvida?

Desde já os meus agradecimentos

Boas....


Uma ideia !!! Coloque um campo sim/não na tabela, e quando o médico for dar alta, ele clica nessa caixa e no código...

if me.suacaixasimnão = -1 then
exit sub

else
o código continua aqui

end if

Uma outra ideia seria deixar a caixa de fim de tratamento oculta e apenas aparecer quando o tratamento realmente tiver terminado.

Caro Sílvio,

Em primeiro lugar grato pela sua colaboração.
Não funciona dá erro.
Como disse no primeiro post o código está num módulo, e depois na origem do controle do campo onde vai aparecer o tempo desde o início do tratamento está o seguinte código:

=CalcularTempTrat([TxtInicioTrat])

Seguindo a sua dica no início do módulo escrevi:

If TxtFimTrat <> " " Then
Exit Function
End If

O campo que me mostra o tempo total de tratamento continua a somar e o utente já teve alta, o campo "TxtFimTrat" está preenchido.

Cumprimentos

Boas....

Partindo do principio, que essa caixa de texto ( final de tratamento ) deverá ser preenchida pelo médico, sugiro que faça
a chamada da rotina no evento Após atualizar dessa caixa e no evento Atual do formulário.

Boa tarde Silvio,
Obrigado pelo "feedback". O que está a sugerir é chamar o módulo no evento após atualizar e no evento actual? Vou testar e depois digo alguma coisa.
Cumprimentos

Algo parecido com isso abaixo:



Private Sub DtPrazos_AfterUpdate()

Call NomeDaSuaRotina

End Sub

Boa tarde Silvio,

Lamentavelmente não funciona, aliás não aparece qualquer tipo de informação, fica o campo em branco.

No evento após atualizar do campo de calculo de tempo:

Private Sub TxtTempoTrat_AfterUpdate()
Call MDL_CALCTEMPTRAT
End Sub

No evento actual do formulário:

Private Sub Form_Current()
Call MDL_CALCTEMPTRAT
End Sub

Cumprimentos

Mas o nome do modulo não é...
CalcularTempTrat

Call CalcularTempTrat

Bom dia Silvio,

Efeticamente houve um erro da minha parte, mas continua a não funcionar.

No evento atual do formulário aparece o erro:
Compile error:
Argument not optional

Cumprimentos

Boas....

Poste aqui as partes envolvidas, tal como tabelas, consultas e formulários para uma melhor analise do problema.

Boa tarde Silvio,

Estou a encurtar o programa porque ele tem 2,44 em zip. Estou a tentar encurtá-lo.

Cumprimentos

Bom dia Silvio,

Envio em anexo o programa para análise.
Desde já o meu muito obrigado pela paciência

Cumprimentos

Boas...

Em qual formulário está dando o erro ?

Boa tarde Silvio,

O erro dá no FRM_UTENTES

Tem que primeiro ir ao formulário FRM_CONSULTA_UTENTES faz duplo click no nome e abre o formulário FRM_UTENTES.

Cumprimentos

Teste e nos informe !!!

Bom dia Silvio,

Lamentavelmente não funciona.

No caso concreto do cliente "Ana Maria Dias" que iniciou tratamento a 15/08/2019 e terminou a 23/09/2020 aparece atualmente no campo "TxtTempoTrat" o valor de 3anos, 7 meses e 1 dia que corresponde ao tempo decorrido entre o início do tratamento (15/08/2019) e a data de hoje. Acontece que o cliente teve um fim de tratamento a 23/09/2020 e quero que apareça o tempo efetivo de tratamento que foi de 1 ano, 1 mês e 8 dias. Porque daqui a 10 anos se eu abrir este processo eu ou outra pessoa qualquer credenciado para ter acesso ao programa saiba de imediato qual o tempo de tratamento que teve há 10 anos atrás, senão o que vai aparecer será qualquer coisa como 13anos e qualquer coisa.
Já me lembrei mas honestamente não sei como fazer, se no modulo CalcularTempTrat houvesse um comando do tipo:

If Me.TxtFimTrat <> " " then
(congelava o campo "TxtTempoTrat")
End if

Cumprimentos e agradecimentos

Olá a todos,

Alberto Rodrigues, já existe aqui no fórum à precisamente treze anos (foi colocado no dia 16/3   ) um excelente exemplo do nosso grande JPaulo:
https://www.maximoaccess.com/t283-calcula-idade

Fiz uma ligeira alteração ao módulo, também adicionei um formulário simples para facilitar o estudo em utilizadores menos experientes.
Verifique se é isto o pretendido.
cld.pt/dl/download/d78ee5ad-bec5-4805-8e08-b2d08b77b3cf/CRTEXP_rev.zip

Nota: o projeto tinha e tem erros de copilação.

Abraço a todos

resolvido