[Resolvido]Cálculo de Tempo

Bom dia a todos,

Amigos tenho duas funções abaixo citadas em um 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 = " , "
If nDMA > 1 Then sSngPlural = " , "
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 = " , "
If nDMA > 1 Then sSngPlural = " , "
sTmp = sTmp & nDMA & sSngPlural

' Bloco Dia ---------------------
NewDate = DateAdd("m", nDMA, NewDate)
nDMA = DateDiff("d", NewDate, dtData2)
sSngPlural = "."
If nDMA > 1 Then sSngPlural = "."
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





Public Function Perm(dtDataPri As Date, dtDataSec As Date) As String
On Error GoTo Perm_Err

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


' Bloco Ano ---------------------
' Calcula número inteiro de anos
nDMA = DateDiff("yyyy", dtDataPri, dtDataSec)
' Se Data1+nDMA>Data2, subtrai 1 ano
If DateAdd("yyyy", nDMA, dtDataPri) > dtDataSec Then
nDMA = nDMA - 1
End If
sSngPlural = " , "
If nDMA > 1 Then sSngPlural = " , "
sTmp = nDMA & sSngPlural

' Bloco Mês ---------------------
' Nova data de referência
NewDate = DateAdd("yyyy", nDMA, dtDataPri)
nDMA = DateDiff("m", NewDate, dtDataSec)
' Se Data1+nDMA>Data2, subtrai 1 mês
If DateAdd("m", nDMA, NewDate) > dtDataSec Then
nDMA = nDMA - 1
End If
sSngPlural = " , "
If nDMA > 1 Then sSngPlural = " , "
sTmp = sTmp & nDMA & sSngPlural

' Bloco Dia ---------------------
NewDate = DateAdd("m", nDMA, NewDate)
nDMA = DateDiff("d", NewDate, dtDataSec)
sSngPlural = "."
If nDMA > 1 Then sSngPlural = "."
sTmp = sTmp & nDMA & sSngPlural

' Valor final da função
Perm = sTmp

Perm_Fim:
Exit Function
Perm_Err:
MsgBox Err.Description
Resume Perm_Fim
End Function

A primeira Calcula o tempo com apenas um valor adicionado e a segunda exige a colocação de dois valores.

Gostaria de saber se há como:

Tendo eu duas caixas de texto de datas onde uma é data entrada e a outra data da saída, existe situações onde a pessoa ainda não saiu da instituição, portanto só temos uma data então a função AnoMesDia resolve. Existem outros casos que a pessoa já foi então temos aí uma data de entrada e outra de saida, no caso a função perm funciona.

O que gostaria de saber é como posso ter executando o resultado de ambas em apenas uma caixa de texto (txtTempoCasa).

Adilson

Consegui,

Peguei duas caixas de textos cada uma com uma função diferente e via VBA ativo a que preciso.


Adilson