MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Alterar código

    Compartilhe

    feio134
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 24
    Registrado : 24/02/2013

    Alterar código

    Mensagem  feio134 em Sex 22 Jan 2016, 19:48

    Boa noite!
    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 **************

      Data/hora atual: Ter 21 Nov 2017, 00:50