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
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