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


2 participantes

    [Resolvido]Dias Uteis e dias Corridos

    avatar
    reinaldo105311
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Dias Uteis e dias Corridos Empty [Resolvido]Dias Uteis e dias Corridos

    Mensagem  reinaldo105311 27/10/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 **************
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Dias Uteis e dias Corridos Empty Re: [Resolvido]Dias Uteis e dias Corridos

    Mensagem  Alexandre Neves 29/10/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
    avatar
    reinaldo105311
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Dias Uteis e dias Corridos Empty Resolvido

    Mensagem  reinaldo105311 4/11/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

    Conteúdo patrocinado


    [Resolvido]Dias Uteis e dias Corridos Empty Re: [Resolvido]Dias Uteis e dias Corridos

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 7/11/2024, 21:43