|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (ActiveX/Controles/DLL)
|
|
 |
Título da Dica: Cálculo de horas
|
 |
|
|
|
Postada em 20/4/2007 por ¨Hennyere¨
Option Explicit
Dim sDelimiter As Integer
'FUNÇÃO ADICIONAL PARA O TRATAMENTO DE HORAS
Private Function CalculaSeg(HoraIni As String, HoraFim As String) As String
Dim Sec1 As Integer, Sec2 As Integer
Sec1 = 0: Sec2 = 0: sDelimiter = 0
If Len(HoraIni) > 5 Then _
Sec1 = Mid(HoraIni, InStrRev(HoraIni, ":") + 1)
If Len(HoraFim) > 5 Then _
Sec2 = Mid(HoraFim, InStrRev(HoraFim, ":") + 1)
If Sec1 > Sec2 Then Sec1 = Sec1 - 60: sDelimiter = 1
CalculaSeg = (Sec1 - Sec2)
CalculaSeg = ":" & Format(SomenteNumeros(CalculaSeg), "00")
End Function
'FUNÇÃO ADICIONAL PARA O TRATAMENTO DE HORAS
Private Function TransformaTempo(cTempo As String) As String
For i = 0 To 23
If Int(Mid(cTempo, 1, 2)) = i Then _
TransformaTempo = i + 24 & Mid(cTempo, 3, 3)
Next
If Len(cTempo) > 5 Then _
TransformaTempo = TransformaTempo & ":00"
End Function
'FUNÇÃO ADICIONAL PARA O TRATAMENTO DE HORAS
Private Function SomenteNumeros(iText As String) As String
Dim i As Integer, j As String
For i = 1 To Len(iText)
If Asc(Mid(iText, i, 1)) < 48 Or _
Asc(Mid(iText, i, 1)) > 57 Then
Else
j = j & Mid(iText, i, 1)
End If
SomenteNumeros = j
Next
End Function
'CALCULA DIFERENÇA DE HORAS
'CRIADA POR JOSEFH HENNYERE SANTOS MIRANDA
'01/01/2007
Public Function DiferencaHoras(HoraIni As String, HoraFim As String) As String
Dim sSec As String
sSec = CalculaSeg(HoraIni, HoraFim)
If SomenteNumeros(HoraIni) > SomenteNumeros(HoraFim) Then
HoraFim = TransformaTempo(HoraFim)
DiferencaHoras = SomenteNumeros(TransformMinutes(HoraFim)) - SomenteNumeros(TransformMinutes(HoraIni))
Else
DiferencaHoras = SomenteNumeros(TransformMinutes(HoraIni)) - SomenteNumeros(TransformMinutes(HoraFim))
End If
DiferencaHoras = SomenteNumeros(DiferencaHoras) - sDelimiter
DiferencaHoras = TransformHour(DiferencaHoras) & sSec
End Function
'TRANSFORMA HORAS EM MINUTOS
'CRIADA POR JOSEFH HENNYERE SANTOS MIRANDA
'01/01/2007
Function TransformMinutes(Horas As String) As Double
Dim h As Integer, m As Integer
h = Mid(Horas, 1, 2) * 60
m = Mid(Horas, InStr(Horas, ":") + 1, 2)
TransformMinutes = h + m
End Function
'TRANSFORMA MINUTOS EM HORAS
'CRIADA POR JOSEFH HENNYERE SANTOS MIRANDA
'01/01/2007
Public Function TransformHour(Minutos As String) As String
On Error GoTo errHandler
Dim h As Integer, m As Integer, s As Integer, j As Integer, i As Integer
For j = 1 To Minutos
For i = 1 To 60
s = i
If s > 59 Then
s = 0
m = m + 1
End If
If m > 59 Then
m = 0
h = h + 1
End If
Next
Next
TransformHour = h & ":" & Format(m, "00")
TransformHour = IIf(Mid(TransformHour, 2, 1) = ":", _
"0" & TransformHour, TransformHour)
Exit Function
errHandler:
TransformHour = Minutos
End Function
Private Sub Command1_Click()
'HORA INICIAL MENOR QUE A HORA FINAL
Dim sMsg(0 To 3) As String
sMsg(0) = "HORA INICIAL(04:00:15) MENOR QUE A HORA FINAL(04:00:30) É IGUAL A UM INTERVALO DE: " & DiferencaHoras("04:00:15", "04:00:30") & vbCrLf & vbCrLf
sMsg(1) = "HORA INICIAL(04:00:15) MAIOR QUE A HORA FINAL(04:00:00) É IGUAL A UM INTERVALO DE: " & DiferencaHoras("04:00:15", "04:00:00") & vbCrLf & vbCrLf
sMsg(2) = "TRANSFORMADO A HORA 04:00:00 EM MINUTOS FICARIA: " & TransformMinutes("04:00:15") & " MINUTOS" & vbCrLf & vbCrLf
sMsg(3) = "TRANSFORMADO 478 MINUTOS EM HORAS FICARIA: " & TransformHour("478") & " HORAS" & vbCrLf & vbCrLf
'
MsgBox sMsg(0) + sMsg(1) + sMsg(2) + sMsg(3), vbExclamation, "::. CÁLCULO DE HORAS"
End Sub
|
|
|
|
|
