sexta-feira, 26 de novembro de 2010

Rotina para geração de gráfico em Barra no Excel

Sub Grafico_Barra

On Error Goto trataerro
'seta a wsheet
xlApp.Sheets("Plan1").Select
'cria o gráfico
xlApp.Charts.Add
With xlApp.ActiveChart
.ChartArea.Select
'tipo do gráfico
.ChartType = xlColumnClustered
'//origem dos dados p/gráficos
.SetSourceData xlApp.Range(xlsheet.Cells(rows + 3, cols + 1 ), xlsheet.Cells( rows + 9, cols + 2)),2
'seta aonde o gráfico será exibido ( nova wsheet / na atual)
.Location 2, "Plan1"
End With
'alinhamento do gráfico
xlApp.ActiveSheet.Shapes(xlApp.ActiveChart.Parent.Name).Top = xlApp.ActiveSheet.Cells(rows , cols + 4 ).Top -133.5
'alinhamento do gráfico
xlApp.ActiveSheet.Shapes(xlApp.ActiveChart.Parent.Name).Left = xlApp.ActiveSheet.Cells(rows , cols + 4 ).Left + 100

Exit Sub
trataerro:
Msgbox " Erro - Rotina:'Grafico_Barra' Linha:"&Cstr(Erl)&" Tipo:"&Cstr(Erl)&" "&Cstr(Error)
Exit Sub
End Sub

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