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]Verificar data de emissão doc - se não for dia útil passará para o dia útil seguinte (incluir feriados nacionais e estaduais)

    avatar
    andre lindolfo
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 139
    Registrado : 17/04/2012

    [Resolvido]Verificar data de emissão doc - se não for dia útil passará para o dia útil seguinte (incluir feriados nacionais e estaduais) Empty Verificar data de emissão doc - se não for dia útil passará para o dia útil seguinte (incluir feriados nacionais e estaduais)

    Mensagem  andre lindolfo 7/5/2012, 20:45

    Olá amigos,

    O grande mestre Alexandre me deu uma grande ajuda, mas agora me deparo com outro problema.
    Tenho a data de emissão de um documento [DtFornec] eu quero que o access verifique se este dia é útil (excluindo finais de semana, e feriados nacionais e estaduais), se não for ele assumir o próximo dia útil.
    Não quero calcular entre data, tenho apenas a dt deste doc e ele passará para o próximo dia útil, caso tenha sido emitido em dia não útil.
    Colo abaixo o código que tenho do Alexandre, acredito que isso facilite o trabalho.

    Option Compare Database
    Option Explicit

    ' 'criada por Alexandre Neves
    ' 'www.esnips.com\web\AlexandreNeves

    Enum NomeEstado
    PAC = 1
    PAL = 2
    PAP = 3
    PAM = 4
    PBA = 5
    PCE = 6
    PDF = 7
    PES = 8
    PGO = 9
    PMA = 10
    Pmt = 11
    PMS = 12
    PMG = 13
    PPA = 14
    PPB = 15
    PPR = 16
    PPE = 17
    PPI = 18
    PRJ = 19
    PRN = 20
    PRS = 21
    PRO = 22
    PRR = 23
    PSC = 24
    PSP = 25
    PSE = 26
    PTO = 27
    End Enum

    Function DiasUteisBrasileiros(DataInicial As Date, DataFinal As Date, Optional Estado As NomeEstado) As Integer
    Dim DataAtual As Date
    DiasUteisBrasileiros = 0
    For DataAtual = DataInicial To DataFinal
    If Not FeriadoBrasileiro(DataAtual, Estado) And Weekday(DataAtual) <> 1 And Weekday(DataAtual) <> 7 Then DiasUteisBrasileiros = DiasUteisBrasileiros + 1
    Next
    End Function

    Function PascoaB(intAno As Integer) As Date
    ' 'criada por Alexandre Neves
    ' 'www.esnips.com\web\AlexandreNeves
    Dim X As Byte, y As Byte
    Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte

    If intAno > 1581 And intAno < 1600 Then X = 22: y = 2
    If intAno > 1599 And intAno < 1700 Then X = 22: y = 2
    If intAno > 1699 And intAno < 1800 Then X = 23: y = 3
    If intAno > 1799 And intAno < 1900 Then X = 23: y = 4
    If intAno > 1899 And intAno < 2000 Then X = 24: y = 5
    If intAno > 1999 And intAno < 2100 Then X = 24: y = 5
    If intAno > 2099 And intAno < 2200 Then X = 24: y = 6
    If intAno > 2199 And intAno < 2300 Then X = 25: y = 7

    a = intAno Mod 19
    b = intAno Mod 4
    c = intAno Mod 7
    d = ((19 * a) + X) Mod 30
    e = ((2 * b) + (4 * c) + (6 * d) + y) Mod 7
    If (d + e) < 10 Then
    PascoaB = DateSerial(intAno, 3, d + e + 22)
    Else
    PascoaB = DateSerial(intAno, 4, d + e - 9)
    End If
    If PascoaB = DateSerial(intAno, 4, 26) Then PascoaB = DateAdd("d", -7, PascoaB)
    If PascoaB = DateSerial(intAno, 4, 25) And d = 28 And a > 10 Then PascoaB = DateAdd("d", -7, PascoaB)
    End Function

    Function FeriadoBrasileiro(dtData As Date, Optional strNomeEstado As NomeEstado) As Boolean
    ' 'criada por Alexandre Neves
    ' 'www.esnips.com\web\AlexandreNeves
    FeriadoBrasileiro = False
    Select Case Format(dtData, "dd-mm")
    Case "01-01"
    FeriadoBrasileiro = True
    Case "21-04"
    FeriadoBrasileiro = True
    Case "01-05"
    FeriadoBrasileiro = True
    Case "07-09"
    FeriadoBrasileiro = True
    Case "12-10"
    FeriadoBrasileiro = True
    Case "02-11"
    FeriadoBrasileiro = True
    Case "15-11"
    FeriadoBrasileiro = True
    Case "25-12"
    FeriadoBrasileiro = True
    End Select

    If dtData = DateAdd("d", -47, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
    If dtData = DateAdd("d", -2, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
    If dtData = PascoaB(Year(dtData)) Then FeriadoBrasileiro = True
    If dtData = DateAdd("d", 49, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
    If dtData = DateAdd("d", 56, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
    If dtData = DateAdd("d", 60, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True

    If Not IsMissing(strNomeEstado) Then
    Select Case strNomeEstado
    Case PAC
    If Format(dtData, "dd-mm") = "15-06" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "06-08" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "05-09" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "17-11" Then FeriadoBrasileiro = True
    Case PAL
    If Format(dtData, "dd-mm") = "24-06" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "29-06" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "16-09" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case PAP
    If Format(dtData, "dd-mm") = "19-03" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case PAM
    If Format(dtData, "dd-mm") = "05-09" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "08-12" Then FeriadoBrasileiro = True
    Case PBA
    If Format(dtData, "dd-mm") = "28-06" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "02-07" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case PDF
    If Format(dtData, "dd-mm") = "21-04" Then FeriadoBrasileiro = True
    Case PES
    If Format(dtData, "dd-mm") = "23-05" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
    Case PGO
    If Format(dtData, "dd-mm") = "26-07" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
    Case PMA
    If Format(dtData, "dd-mm") = "28-07" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "28-12" Then FeriadoBrasileiro = True
    Case Pmt
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case PMS
    If Format(dtData, "dd-mm") = "11-10" Then FeriadoBrasileiro = True
    Case PPA
    If Format(dtData, "dd-mm") = "15-08" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "08-12" Then FeriadoBrasileiro = True
    Case PPB
    If Format(dtData, "dd-mm") = "05-08" Then FeriadoBrasileiro = True
    Case PPR
    If Format(dtData, "dd-mm") = "08-09" Then FeriadoBrasileiro = True
    Case PPE
    If Format(dtData, "dd-mm") = "06-03" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "24-06" Then FeriadoBrasileiro = True
    Case PPI
    If Format(dtData, "dd-mm") = "13-03" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "19-10" Then FeriadoBrasileiro = True
    Case PRJ
    If Format(dtData, "dd-mm") = "21-01" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "23-04" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "18-10" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case PRN
    If Format(dtData, "dd-mm") = "29-06" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "03-10" Then FeriadoBrasileiro = True
    Case PRS
    If Format(dtData, "dd-mm") = "20-09" Then FeriadoBrasileiro = True
    Case PRO
    If Format(dtData, "dd-mm") = "04-01" Then FeriadoBrasileiro = True
    Case PRR
    If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
    Case PSC
    If Format(dtData, "dd-mm") = "11-08" Then FeriadoBrasileiro = True
    Case PSP
    If Format(dtData, "dd-mm") = "09-07" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case PSE
    If Format(dtData, "dd-mm") = "08-07" Then FeriadoBrasileiro = True
    Case PTO
    If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
    End Select
    End If
    End Function

    Tenho ainda uma outra funç~´ao que faz a conversão, uma vez que a minha sigla do estado tem a letra "P" na frente.
    Function Estado(strEstado As String) As NomeEstado
    Select Case strEstado
    Case "PAC"
    Estado = 1
    Case "PAL"
    Estado = 2
    Case "PAP"
    Estado = 3
    Case "PAM"
    Estado = 4
    Case "PBA"
    Estado = 5
    Case "PCE"
    Estado = 6
    Case "PDF"
    Estado = 7
    Case "PES"
    Estado = 8
    Case "PGO"
    Estado = 9
    Case "PMA"
    Estado = 10
    Case "PMT"
    Estado = 11
    Case "PMS"
    Estado = 12
    Case "PMG"
    Estado = 13
    Case "PPA"
    Estado = 14
    Case "PPB"
    Estado = 15
    Case "PPR"
    Estado = 16
    Case "PPE"
    Estado = 17
    Case "PPI"
    Estado = 18
    Case "PRJ"
    Estado = 19
    Case "PRN"
    Estado = 20
    Case "PRS"
    Estado = 21
    Case "PRO"
    Estado = 22
    Case "PRR"
    Estado = 23
    Case "PSC"
    Estado = 24
    Case "PSP"
    Estado = 25
    Case "PSE"
    Estado = 26
    Case "PTO"
    Estado = 27
    End Select
    End Function



    []s aos feras de plantão.

    André Lindolfo
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Verificar data de emissão doc - se não for dia útil passará para o dia útil seguinte (incluir feriados nacionais e estaduais) Empty Re: [Resolvido]Verificar data de emissão doc - se não for dia útil passará para o dia útil seguinte (incluir feriados nacionais e estaduais)

    Mensagem  Alexandre Neves 7/5/2012, 21:08

    Boa noite, André

    Veja se funciona (não testei)
    Function DiaUtil(DataInicial As Date, Optional Estado As NomeEstado) As Date
    'criada por Alexandre Neves
    'em 2012-05-07

    DiaUtil=DataInicial
    Do
    If Not FeriadoBrasileiro(DiaUtil, Estado) and Weekday(DiaUtil) <> 1 and Weekday(DiaUtil) <> 7 Then Exit do
    DiaUtil = DateAdd("d", 1, DiaUtil)
    Loop
    End Function

    Tem de puxar pelos neurónios!
    avatar
    andre lindolfo
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 139
    Registrado : 17/04/2012

    [Resolvido]Verificar data de emissão doc - se não for dia útil passará para o dia útil seguinte (incluir feriados nacionais e estaduais) Empty Re: [Resolvido]Verificar data de emissão doc - se não for dia útil passará para o dia útil seguinte (incluir feriados nacionais e estaduais)

    Mensagem  andre lindolfo 8/5/2012, 15:36

    Mestre Alexandre,

    Funcionou.

    Muito obrigado.

    Não entendo nada de códigos e estou me aventurando neste universo.

    []s

    Conteúdo patrocinado


    [Resolvido]Verificar data de emissão doc - se não for dia útil passará para o dia útil seguinte (incluir feriados nacionais e estaduais) Empty Re: [Resolvido]Verificar data de emissão doc - se não for dia útil passará para o dia útil seguinte (incluir feriados nacionais e estaduais)

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 27/4/2024, 15:30