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

    [Resolvido]Dias Uteis e dias Corridos

    Compartilhe

    reinaldo105311
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2
    Registrado : 28/01/2014

    [Resolvido]Dias Uteis e dias Corridos

    Mensagem  reinaldo105311 em Seg 27 Out 2014, 08:43

    Bom dia, estou com um Banco de dados e nele tenho 02 datas, Data_envio e Data_retorno onde o prazo entre as duas datas é de 10 dias úteis.
    Tenho um código que conta os dez dias úteis.
    Preciso que após os dez dias úteis ele comece a contar dias corridos novamente.
    Ex: data_envio 08/10/2014 e data_retorno 30/10/2014 = 17 dias úteis
    preciso de 08/10/2014 - 30/10/2014 seja = á 19 dias 10 dias úteis e 9 dias corridos porque ultrapassou os 10 dias de prazo. 9 dias é multa.

    Poderiam me ajudar?

    Public Function DTS(dtInicio As Date, dtFim As Date, Optional HojeTb As Boolean = False, Optional UltTb As Boolean = False) As Integer

    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
       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 **************
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6312
    Registrado : 05/11/2009

    Re: [Resolvido]Dias Uteis e dias Corridos

    Mensagem  Alexandre Neves em Qua 29 Out 2014, 09:29

    Bom dia, e bem-vindo ao fórum
    Eliminei-lhe a outra mensagem por ser duplicada desta.
    Existe regra para poder refrescar o assunto, pode-a utilizar.
    Aguarde que algum colega o possa ajudar.


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

    reinaldo105311
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2
    Registrado : 28/01/2014

    Resolvido

    Mensagem  reinaldo105311 em Ter 04 Nov 2014, 15:18

    Consegui este código e funcionou perfeitamente.
    Agradeço a todos .

    Option Compare Database

    Public Function DataUtil(DataInicial As Date, QtdDiasUteis As Integer) As Date
    '-------------------------------------
    ' Calcula uma nova data futura -
    ' desconsiderando Sábados e Domingos -
    '------ Passarella ------
    'Para utilizar esta função, digite o seguinte código no local (evento) que julgar adequado:

    'SuaDataFinal = DataUtil(SuaDataInicial, SeusDiasUteis)

    'COMPLEMENTO ADICIONAL DOS FERIADOS POR SÍLVIO MOSER
    'CRIE UMA TABELA CHAMADA FERIADO ONDE É CADASTRADO AS DATAS COM FERIADO
    '
    '************************************************
    'CAMPO TIPO FORMATO
    '************************************************
    'dt_feriado Date/Time Short Date (PK)
    'ds_feriado Text

    Dim DataFinal As Date
    Dim dias, Semana As Integer
    Dim db As Database
    Dim rs_fer As Recordset

    Set db = CurrentDb
    Set rs_fer = db.OpenRecordset("aadias", dbOpenDynaset)

    dias = 0
    DataFinal = DataInicial

    While dias < QtdDiasUteis
    DataFinal = DataFinal + 1
    Semana = Weekday(DataFinal)
    If Semana <> 1 And Semana <> 7 Then ' 1=Domingo 7=Sábado


    rs_fer.FindFirst "[dt_dia] = #" & Format(DataFinal, "mm/dd/yy") & "#"
    If rs_fer.NoMatch Then



    dias = dias + 1
    End If
    End If
    Wend

    DataUtil = DataFinal







    End Function

      Data/hora atual: Ter 22 Ago 2017, 15:49