USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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
 


CyberWEB Network Ltda.    © Copyright 2000-2018   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página