Veja esse exemplo se ajuda em algo.
Private Sub Command1_Click()
On Error Resume Next
'variáveis para soma de horas
Dim tempo As Long
Dim min As Long, hora As Long
Dim matriz
Dim matriz2
Dim TotalMin, TotalHoras
Dim Linha As Double
Dim Horas As Date
Horas = "00:00"
TotalMin = 0
TotalHoras = 0
Screen.MousePointer = 11
'Carregar o Excel:
Set Planilha = CreateObject("Excel.Application")
Set PlanilhaExistente = Planilha.Workbooks.Open(App.Path & "pasta2.xls") ' chama a planilha existente
Set NomePlanilha = Planilha.Worksheets("Plan1") ' a plan que ira receber os dados
'valores nas células
Data1.DatabaseName = App.Path & "compras.mdb"
Data1.RecordSource = "select * from apontamento where nome='" & CboNome.Text & "' and datalancamento between #" & Format(TxtInicial.Text, "mm/dd/yyyy") & "# and #" & Format(TxtFinal.Text, "mm/dd/yyyy") & "# order by pspf,datalancamento desc"
Linha = 5
PsPf = 0
Data1.Refresh
Data1.Recordset.MoveMin
While Not Data1.Recordset.EOF
'por existir dias que não serão lançados, ou por serem feriados, finais de semana
'ou mesmo por não ter 31 dias, foi colocado esse rotina para posicionar o dia correto
If Data1.Recordset!Dia = "01" Then coluna = 13
If Data1.Recordset!Dia = "02" Then coluna = 14
If Data1.Recordset!Dia = "03" Then coluna = 15
If Data1.Recordset!Dia = "04" Then coluna = 16
If Data1.Recordset!Dia = "05" Then coluna = 17
If Data1.Recordset!Dia = "06" Then coluna = 18
If Data1.Recordset!Dia = "07" Then coluna = 19
If Data1.Recordset!Dia = "08" Then coluna = 20
If Data1.Recordset!Dia = "09" Then coluna = 21
If Data1.Recordset!Dia = "10" Then coluna = 22
If Data1.Recordset!Dia = "11" Then coluna = 23
If Data1.Recordset!Dia = "12" Then coluna = 24
If Data1.Recordset!Dia = "13" Then coluna = 25
If Data1.Recordset!Dia = "14" Then coluna = 26
If Data1.Recordset!Dia = "15" Then coluna = 27
If Data1.Recordset!Dia = "16" Then coluna = 28
If Data1.Recordset!Dia = "17" Then coluna = 29
If Data1.Recordset!Dia = "18" Then coluna = 30
If Data1.Recordset!Dia = "19" Then coluna = 31
If Data1.Recordset!Dia = "20" Then coluna = 32
If Data1.Recordset!Dia = "21" Then coluna = 2
If Data1.Recordset!Dia = "22" Then coluna = 3
If Data1.Recordset!Dia = "23" Then coluna = 4
If Data1.Recordset!Dia = "24" Then coluna = 5
If Data1.Recordset!Dia = "25" Then coluna = 6
If Data1.Recordset!Dia = "26" Then coluna = 7
If Data1.Recordset!Dia = "27" Then coluna = 8
If Data1.Recordset!Dia = "28" Then coluna = 9
If Data1.Recordset!Dia = "29" Then coluna = 10
If Data1.Recordset!Dia = "30" Then coluna = 11
If Data1.Recordset!Dia = "31" Then coluna = 12
If PsPf = 0 Then
PsPf = Data1.Recordset!PsPf
Else
If PsPf <> Data1.Recordset!PsPf Then
If TotalMin <= 9 Then TotalMin = Format(TotalMin, "0#")
If TotalHoras <= 9 Then TotalHoras = Format(TotalHoras, "0#")
TotalHoras = TotalHoras & ":" & TotalMin
NomePlanilha.Cells(Linha, 33).value = TotalHoras
Linha = Linha + 1
PsPf = Data1.Recordset!PsPf
TotalMin = 0
TotalHoras = 0
End If
End If
NomePlanilha.Cells(Linha, 1).value = PsPf
NomePlanilha.Cells(Linha, coluna).value = Data1.Recordset!Horas
'se tivesse mais horas, poderia colocar dentro do array, separado
'por vírgula e entre aspas
matriz = Array(Data1.Recordset!Horas)
tempo = 0
'o For ,caso tenha mais horas ele parte para a próxima
For I = 0 To UBound(matriz)
matriz2 = Split(matriz(I), ",")
'nesse caso ele dividiu a hora em duas partes, pois ele achou a ,
tempo = tempo + (CLng(matriz2(0)) * 3600) 'retira a hora e transforma em nº
tempo = tempo + (CLng(matriz2(1)) * 60) 'retira os minutos e transforma em nº
Next
tempo = tempo / 60 'Tempo = total em segundos
min = tempo Mod 60
hora = Val(tempo / 60) 'O val está pegando o número inteiro, já que os minutos já foram calculados
TotalMin = TotalMin + min
If TotalMin > 59 Then
TotalMin = TotalMin - 60
TotalHoras = TotalHoras + 1
End If
TotalHoras = TotalHoras + hora
TotalMinGeral = TotalMinGeral + min
Data1.Recordset.MoveNext
Wend
'exibe o último cálculo
If TotalMin <= 9 Then TotalMin = Format(TotalMin, "0#")
If TotalHoras <= 9 Then TotalHoras = Format(TotalHoras, "0#")
TotalHoras = TotalHoras & ":" & TotalMin
NomePlanilha.Cells(Linha, 33).value = TotalHoras
Data1.RecordSource = "select * from pspf order by Npfps"
Data1.Refresh
Data1.Recordset.MoveMin
Linha = 32
While Not Data1.Recordset.EOF
If Data1.Recordset!Status = "Edição" Then
NomePlanilha.Cells(Linha, 10).value = Data1.Recordset!npfps
NomePlanilha.Cells(Linha, 13).value = Data1.Recordset!Descricao1
NomePlanilha.Cells(Linha, 25).value = Data1.Recordset!Cliente
Linha = Linha + 1
End If
Data1.Recordset.MoveNext
Wend
NomePlanilha.Cells(31, 2).value = CboNome.Text
NomePlanilha.Cells(32, 2).value = CDate(TxtInicial.Text) & " " & CDate(TxtFinal.Text)
NomePlanilha.Cells(36, 2).value = "_________________________________"
Planilha.Visible = True
Screen.MousePointer = 0
Set Planilha = Nothing
Set PlanilhaExistente = Nothing
Set NomePlanilha = Nothing
End Sub
