MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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


    Alterar código

    avatar
    feio134
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

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

    Alterar código Empty Alterar código

    Mensagem  feio134 22/1/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: 19/4/2024, 04:12