MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

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: Dom 04 Dez 2016, 12:13