Ir para conteúdo
Fórum Script Brasil
  • 0

Alterar código


feio134

Pergunta

Boa noite!
Alguém fazia o favor de fazer com que este código conta-se só 8 horas por cada dia util
 

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 **************
Voltar ao TopoEditar/excluir esta mensagemExcluir esta mensagem

 

Link para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,8k
×
×
  • Criar Novo...