Boa noite!
Alguém fazia o favor de fazer com que este código conta-se só 8 horas por cada dia util
Alguém fazia o favor de fazer com que este código conta-se só 8 horas por cada dia util
- Código:
Option Compare Database
Option Explicit
Public Function DTS(dtInicio As Date, dtFim As Date, Optional HojeTb As Boolean = False, Optional UltTb As Boolean = False) As Integer
'....................................................................
' Nome: DTS
' Entradas: dtInicio As Date
' dtFim As Date
' HojeTb As Boolean
' UltTb As Boolean
' Saída: Integer
' Autor: Arvin Meyer
' Data: Maio 5,2002
' Comentário: Aceita duas datas e devolve o número de dias úteis
' entre elas. 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.
' Se HojeTb = True, a data inicial também será considerada.
' Se UltTb = true, a data final também será considerada.
'....................................................................
On Error GoTo Err_DTS
Dim intCount As Integer
Dim rst As DAO.Recordset
Dim DB As DAO.Database
Set DB = CurrentDb
Set rst = DB.OpenRecordset("SELECT [FerData] FROM tblFeriados", dbOpenSnapshot)
If Not HojeTb Then
dtInicio = dtInicio + 1
End If
' Se desejar contar a data de início, passe True em HojeTb
intCount = 0
If UltTb Then
Do While dtInicio <= dtFim
rst.FindFirst "[FerData] = #" & Format(dtInicio, "mm/dd/yyyy") & "#"
If Weekday(dtInicio) <> vbSunday And Weekday(dtInicio) <> vbSaturday Then
If rst.NoMatch Then intCount = intCount + 1
End If
dtInicio = dtInicio + 1
Loop
Else
Do While dtInicio < dtFim
rst.FindFirst "[FerData] = #" & Format(dtInicio, "mm/dd/yyyy") & "#"
If Weekday(dtInicio) <> vbSunday And Weekday(dtInicio) <> vbSaturday Then
If rst.NoMatch Then intCount = intCount + 1
End If
dtInicio = dtInicio + 1
Loop
End If
DTS = intCount
Exit_DTS:
Exit Function
Err_DTS:
Select Case Err
Case Else
MsgBox Err.Description
Resume Exit_DTS
End Select
End Function
'*********** Code End **************