quarta-feira, 10 de dezembro de 2008

Somar Horas no Access pelo VBA

Uma das coisas que mais me perguntam é como somar horas em um formulário no Access, como sabem se você simplemente pedir para somar um campo a outro ele trará um resultado incorreto, mas neste exemplo abaixo a idéia é converte as horas em numeros, soma-las e o resultado voltar a converte-los em horas.

Segue abaixo duas funções, uma para converter horas em numeros e a outra para converter numero em horas.


Clique aqui e baixe um exemplo


_________________________________________________
Public Function HrStr(dblHora As Double) As String
'Pega um valor numérico e o converte para Horas/Minutos
'Ex: 123,5 = "123:30"
'Ex: 23,9833333333333 = "23:59"

Dim strHoras As String
Dim strMinutos As String

'Pega as horas (parte inteira)
strHoras = CStr(Fix(dblHora))

'Pega os minutos
strMinutos = Format$(Abs((dblHora - Fix(dblHora)) * 60), "00")

'Verifica se o total de minutos é 60
If strMinutos = "60" Then
strMinutos = "00"
strHoras = CStr(CDbl(strHoras) + 1)
End If

'Concatena os dois
HrStr = strHoras & ":" & strMinutos

End Function

'Esta outra função faz o contrário: pega um string no formato de horas e converte para número:

Public Function HrDbl(stHora As String) As Double
'Converte um string de hora (formato (h)hh:mm) para Double
'Ex: "135:30" = 135,5
'Ex: "23:59" = 23,9833333333333
Dim dblHoras As Double
Dim intMinutos As Integer
Dim blnDoisPontos As Boolean, blnNum As Boolean
Dim strNum As String

'Verifica se o sinal de dois pontos ':' está na terceira casa
'da direita para esquerda
If Asc(Left(Right(stHora, 3), 1)) = 58 Then
blnDoisPontos = True
Else
blnDoisPontos = False
End If

'Verifica se o resto dos dígitos são numéricos
strNum = Left(stHora, Len(stHora) - 3) & Right(stHora, 2)
If IsNumeric(strNum) = True Then
blnNum = True
Else
blnNum = False
End If

'Sai do procedimento se o formato estiver incorreto
If (blnDoisPontos = False) Or (blnNum = False) Then
MsgBox "Informe a hora no formato hh:mm", vbCritical + vbOKOnly
Exit Function
End If

'Pega os minutos
If CDbl(strNum) < 0 Then

intMinutos = CInt(Right(strNum, 2)) * (-1) Else intMinutos = CInt(Right(strNum, 2))

End If

'Pega as horas

dblHoras = Fix(CDbl(Left(strNum, Len(strNum) - 2)))

'Calcula a hora

HrDbl = dblHoras + (intMinutos / 60)


End Function

Nenhum comentário: