quinta-feira, 18 de novembro de 2010

Cálculo de horas

Sub Click(Source As Button)

On Error Goto erro

Dim ws As New NotesUIWorkspace
Dim doc As NotesDocument
Set doc = ws.CurrentDocument.Document

Dim aux1 As Double
Dim aux2 As Double
Dim aux3 As Double
Dim aux4 As Double
Dim aux5 As Double


aux1 = RetornaHora(doc.campo1(0))
aux2 = RetornaHora(doc.campo2(0))

aux3 = aux1 + aux2

Msgbox ConvertToHHMM(aux3)


Exit Sub
erro:
Msgbox "Linha:" & Cstr(Erl) & " tipo" & Cstr(Err) & " " & Cstr(Error)
Exit Sub
End Sub


Function RetornaHora(hora As String) As Double
On Error Goto erro

Dim hr As Double
Dim min As Double
Dim aux As Double

hr = Hour(hora)
min = Minute(hora)
aux = hr + (min / 60)
RetornaHora = aux

Exit Function
erro:
Msgbox "Linha:" & Cstr(Erl) & " tipo" & Cstr(Err) & " " & Cstr(Error)
Exit Function
End Function

Function ConvertToHHMM(dbl_hora As Double) As String
On Error Goto TrataErro

ConvertToHHMM = ""

hr
min =0 str_hr =""
str_min =""

If Instr(Cstr(dbl_hora),",") > 0 Then
hr = Cint(Strleft(Cstr(dbl_hora),","))
min = Fraction(dbl_hora) * 60

If Len(Cstr(hr)) > 1 Then
str_hr = Cstr(hr)
Else
str_hr = "0"+Cstr(hr)
End If

If Len(Cstr(min)) > 1 Then
str_min = Cstr(min)
Else
str_min = "0"+Cstr(min)
End If

' Msgbox Cstr(hr) & ":"& Cstr(min)
Else
If Len(Cstr(dbl_hora)) > 1 Then
str_hr = Cstr(dbl_hora)
Else
str_hr = "0"+Cstr(dbl_hora)
End If
str_min = "00"
End If

ConvertToHHMM=str_hr+":"+str_min

Exit Function
TrataErro:
Msgbox "Erro - Agente: 'NOMEDOAGENTE' Função:'ConvertToHHMM' - Linha:"&Cstr(Erl)&" Tipo:"&Cstr(Err)&" "&Cstr(Error),16,"Operação Cancelada"
Exit Function
End Function

Nenhum comentário:

Postar um comentário