Este fórum está sendo desativado

[feio134]

A todo o Pessoal do do Fórum um bom dia, um bom fim de semana Prolongado!

O que me leva a novamente estar a chatear-vos é o seguinte, tenho um código que está num ficheiro access e que precisava colocar a funcionar no Excel.

Dava para dar uma ajuda? desde já um muito obrigado e um bom fim de semana de Páscoa.

Código: Selecionar todos

Option Explicit
Public Function DuracaoTarefa(dtInicio As Date, dtFim As Date) As Integer
'....................................................................
' Nome:  DuracaoTarefa
' Entradas: dtInicio As Date
'                dtFim As Date
' Saída: Integer (Minutos)
' Autor: Arvin Meyer
' Data:  Maio 5,2002
' Comentário:
' Aceita duas datas e devolve o número de minutos entre elas. Tem conta
' o horário definido na tabela "tblHorario".
' O horário é definido em 3 períodos. O inicio/fim de cada período é
' definido com o número de minutos desde as 0 horas.
' Note-se que esta função considera os feriados do período. Ela exige a
' existência de uma tabela chamada "tblFeriados" com um campo, no formato
' data, chamado FerData. Os Domingos também são ignorados.
'....................................................................
On Error GoTo Err_DuracaoTarefa
Dim intCount As Integer
Dim DB As DAO.Database
Dim rst As DAO.Recordset
Dim rst_horario As DAO.Recordset
Dim TotalMinutos
Dim TotalMinutosFora
Dim MinutoAtual
Dim P1I, P1F
Dim P2I, P2F
Dim P3I, P3F
Dim DiaAtual As Date
Dim MinutoInicial As Integer
Dim MinutoFinal As Integer
TotalMinutos = 0

DiaAtual = dtInicio
Set DB = CurrentDb
Set rst = DB.OpenRecordset("SELECT [FerData] FROM tblFeriados", dbOpenSnapshot)
intCount = 0
         Do While DiaAtual < dtFim
                 rst.FindFirst "[FerData] = #" & Format(DiaAtual, "mm/dd/yyyy") & "#"
                 If Weekday(DiaAtual) <> vbSunday Then '' And Weekday(dtInicio) <> vbSaturday Then
                         If rst.NoMatch Then
                                 'Se chegou aqui é porque é dia útil e não é feriado
                                 Set rst_horario = DB.OpenRecordset("SELECT * FROM tblHorario where HorarioDiaSemanaNum = " & Weekday(DiaAtual), dbOpenSnapshot)
                                 P1I = rst_horario("HorarioP1Inicio")
                                 P1F = rst_horario("HorarioP1Fim")
                                 P2I = rst_horario("HorarioP2Inicio")
                                 P2F = rst_horario("HorarioP2Fim")
                                 P3I = rst_horario("HorarioP3Inicio")
                                 P3F = rst_horario("HorarioP3Fim")
                                
                                 If Day(dtFim) = Day(dtInicio) And dtFim - dtInicio < 24 Then ' Inicia e termina no mesmo dia
                                         MinutoInicial = Hour(dtInicio) * 60 + Minute(dtInicio)
                                         MinutoFinal = Hour(dtFim) * 60 + Minute(dtFim)
                                         For MinutoAtual = MinutoInicial To MinutoFinal
                                                 If (MinutoAtual >= P1I And MinutoAtual < P1F) Then      'Periodo 1
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P2I And MinutoAtual < P2F) Then 'Periodo 2
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P3I And MinutoAtual < P3F) Then 'Periodo 3
                                                         TotalMinutos = TotalMinutos + 1
                                                 Else
                                                         TotalMinutosFora = TotalMinutosFora + 1
                                                 End If
                                         Next
                                 ElseIf DiaAtual = dtInicio Then 'Tratamento 1º dia
                                         MinutoInicial = Hour(dtInicio) * 60 + Minute(dtInicio)
                                         MinutoFinal = 1440
                                         For MinutoAtual = MinutoInicial To MinutoFinal - 1
                                                 If (MinutoAtual >= P1I And MinutoAtual < P1F) Then      'Periodo 1
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P2I And MinutoAtual < P2F) Then 'Periodo 2
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P3I And MinutoAtual < P3F) Then 'Periodo 3
                                                         TotalMinutos = TotalMinutos + 1
                                                 Else
                                                         TotalMinutosFora = TotalMinutosFora + 1
                                                 End If
                                         Next
                        
                                 ElseIf Day(DiaAtual) = Day(dtFim) And dtFim - DiaAtual < 24 Then 'Tratamento último dia
                                                                        
                                         MinutoInicial = 0
                                         MinutoFinal = Hour(dtFim) * 60 + Minute(dtFim)
                                         For MinutoAtual = MinutoInicial To MinutoFinal - 1
                                                 If (MinutoAtual >= P1I And MinutoAtual < P1F) Then      'Periodo 1
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P2I And MinutoAtual < P2F) Then 'Periodo 2
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P3I And MinutoAtual < P3F) Then 'Periodo 3
                                                         TotalMinutos = TotalMinutos + 1
                                                 Else
                                                         TotalMinutosFora = TotalMinutosFora + 1
                                                 End If
                                         Next
                                 ElseIf DiaAtual > dtInicio And DiaAtual < dtFim Then
                                         For MinutoAtual = 0 To 1440
                                                 If (MinutoAtual >= P1I And MinutoAtual < P1F) Then      'Periodo 1
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P2I And MinutoAtual < P2F) Then 'Periodo 2
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P3I And MinutoAtual < P3F) Then 'Periodo 3
                                                         TotalMinutos = TotalMinutos + 1
                                                 Else
                                                         TotalMinutosFora = TotalMinutosFora + 1
                                                 End If
                                         Next
                                 Else
                                 End If
                                 'intCount = intCount + 1
                         Else
                         End If
                 End If
                 DiaAtual = DiaAtual + 1
         Loop
        
DuracaoTarefa = TotalMinutos

Exit_DuracaoTarefa:
Exit Function
Err_DuracaoTarefa:
Select Case Err
Case Else
MsgBox Err.Description
Resume Exit_DuracaoTarefa
End Select
End Function