Ajustar a Data de Vencimento para o dia útil
Nota importante: para ter acesso aos vídeos e arquivos exemplos deste site, adquira um dos planos apresentados abaixo. Você pode comprar em até 5x no Cartão de Crédito, através do Paypal.
Veja como comprar e saiba mais sobre o material oferecido, clicando aqui.
Em um sistema de Contas a Pagar é importante observar a Data de Vencimento e fazer o ajuste necessário se a data cair em um final de semana ou feriado. Tratando-se de contas federais, a data de vencimento precisa ser antecipada, enquanto que as demais podem ser postergadas para o próximo dia útil.
Para as contas postergadas, a função precisa ir analisando os dias posteriores à data de vencimento até encontrar o próximo dia útil. Veja, como exemplo, a seqüência de datas de 2014, considerando a data de vencimento 18/04:
18/04 - Sexta-feira da Paixão
19/04 - Sábado
20/04 - Domingo
21/04 - Inconfidência Mineira
Como podemos observar, a data de vencimento (18/04) cai em um feriado, assim sendo, a função precisa ajustar a data para o dia seguinte. Como o dia seguinte cai no sábado, torna-se necessário que a função faça novo ajuste, jogando a data para segunda-feira. Como segunda-feira também é feriado, mais um ajuste será feito, tendo como resultado final a data postergada para terça-feira, 22/04.
18/04(feriado) ::::> 19/04(sábado) ::::> 21/04(feriado) ::::> 22/04 (dia útil)
Uma forma de se reavaliar a data ajustada é fazer uso da RECURSIVIDADE, que é INVOCAR a função dentro da própria função, criando assim um laço até que se atenda a condição imposta.
Funções Recursivas
Tenho visto, com raridade, o uso de funções recursivas entre os programadores de VBA para Access. O pessoal usa mais os laços FOR e DO WHILE para alcançar o resultado desejado, mas dependendo do caso é possível montar um código mais simples ao fazer uso da recursividade.
Devemos utilizar funções recursivas com cautela, pois são mais lentas que as funções interativas.
Um exemplo clássico de função recursiva é no cálculo de Fatorial. Antes, observe a função interativa que calcula o Fatorial:
Public Function fncFatorial(numero%) As Long Dim Fatorial as Long, I as Integer Fatorial = 1 For I = 1 To numero Fatorial = Fatorial * I Next fncFatorial = Fatorial End Function
Agora, observe a utilização de função recursiva:
Public Function fncFatorial(numero%) As Long If numero <= 1 Then fncFatorial = 1 Else fncFatorial = numero * fncFatorial(numero - 1) End If End Function
Testando:
fncFatorial(5) ::::> 120 (5*4*3*2*1)
Feriados Móveis
Existe uma função que calcula o dia de Domingo de Páscoa, em função do ano informado. Baseado no dia de Páscoa é possível calcular o feriado de Carnaval que é 47 dias antes e o feriado de Corpus Christi que é 60 dias depois. Veja o cálculo na função fncFeriadoMoveis() abaixo:
Função Completa:
Atente para os comentários e observe bem que a função fncAjustarData() será invocada no código, enquanto a variável NovaData não coincidir com o argumento dataInformada.
Option Compare Database
Private intFeriado(14) As Integer
'-------------------------------------------------------------------------------------
Public Function fncAjustarData(dataInformada As Date, Optional Federal As Boolean) As Date
Dim j%, NovaData As Date
'--------------------------------------
'Feriados fixos no formato MêsDia(mmdd)
'--------------------------------------
intFeriado(0) = 1231 '31/12 - Véspera Confraternização Universal"
intFeriado(1) = 101 '01/01 - Confraternização Universal"
intFeriado(2) = 421 '21/04 - Tiradentes"
intFeriado(3) = 501 '01/05 - Dia do Trabalho
intFeriado(4) = 907 '07/09 - Independência do Brasil"
intFeriado(5) = 1012 '12/10 - Nossa Senhora Aparecida"
intFeriado(6) = 1102 '02/11 - Finados"
intFeriado(7) = 1115 '15/11 - Proclamação da República
intFeriado(8) = 1120 '20/11 - Dia da consciência Negra
intFeriado(9) = 1224 '24/12 - Véspera de Natal
intFeriado(10) = 1225 '25/12 - Natal
'---------------------------------------
'Feriados móveis no formato MêsDia(mmdd)
'---------------------------------------
Call fncFeriadosMóveis(Year(dataInformada))
NovaData = dataInformada
'------------------------------------------------------------------------------
'Ajusta a data para o dia seguinte ou para o dia anterior, caso caia no feriado
'------------------------------------------------------------------------------
For j = 0 To 13
If intFeriado(j) = Format(dataInformada, "mmdd") Then
NovaData = dataInformada + IIf(Federal, -1, 1)
Exit For
End If
Next
'-----------------------------------------------------------------------------
'Ajusta a data para segunda-feira ou sexta-feira, caso caia no final de semana
'-----------------------------------------------------------------------------
If Weekday(NovaData) = 7 Then NovaData = NovaData + IIf(Federal, -1, 2)
If Weekday(NovaData) = 1 Then NovaData = NovaData + IIf(Federal, -2, 1)
'-----------------------------------------------------------------
'Se a data informada sofreu ajuste, chamar novamente pela função
'para uma nova verificação.
'----------------------------------------------------------------
If NovaData <> dataInformada Then NovaData = fncAjustarData(NovaData, Federal)
fncAjustaData = NovaData
End Function'----------------------------------------------------------------------------------
Private Sub fncFeriadosMóveis(ano%)
Dim dt_Páscoa As Date
Dim A%, B%, C%, D%, E%, F%, G%, H%, I%, k%, L%, M%, P%, Q%
A = (ano Mod 19)
B = Int(ano / 100)
C = (ano Mod 100)
D = Int(B / 4)
E = (B Mod 4)
F = Int((B + 8) / 25)
G = Int((B - F + 1) / 3)
H = ((19 * A + B - D - G + 15) Mod 30)
I = Int(C / 4): k = (C Mod 4)
L = ((32 + 2 * E + 2 * I - H - k) Mod 7)
M = Int((A + 11 * H + 22 * L) / 451)
P = Int((H + L - 7 * M + 114) / 31)
Q = ((H + L - 7 * M + 114) Mod 31)
dt_Páscoa = CDate((Q + 1) & "/" & P & "/" & ano) 'Domingo de Páscoa
intFeriado(11) = Format(DateAdd("d", -47, dt_Páscoa), "mmdd") 'Carnaval
intFeriado(12) = Format(DateAdd("d", -2, dt_Páscoa), "mmdd") 'Sexta Feira Santa
intFeriado(13) = Format(DateAdd("d", 60, dt_Páscoa), "mmdd") 'Corpus Crist
End SubVencimento de contas federais
Usamos o argumento Federal(true/false) na função para determinar se o cálculo será antecipado ou postergado.
Testando:
fncAlterarData(#04/18/2014#, false) :::> 22/04/2014 - pagamento postergado
fncAlterarData(#04/18/2014#, true) :::> 17/04/2014 - Pagamento antecipado (contas federais)
Arquivo Exemplo
Ao abrir o arquivo exemplo um formulário será exibido para que você possa testar a função.
Selecione a opção (antecipar ou postergar) , entre com a data 18/04/2014 e veja o resultado.
Desafios
A função abaixo transforma o valor Decimal em Binário.
Public Function fncDecBin(dec) Dim bin$ If dec = 0 Then bin = "0" Do While Not dec = 0 bin = (dec - Int(dec / 2) * 2) & bin dec = Int(dec / 2) Loop fncDecBin = bin End Function
Desafio 1 : Altere a função acima, utilizando a Recursividade.
Desafio 2 : Altere a fncAjustarData() para que funcione sem a recursividade.
Bom estudo!
Newsletter (novos artigos para você)
Clique aqui e cadastre-se para receber comunicados sobre novos artigos.
Os dez artigos mais visitados
MontaRibbons v.7.0 - Assistente completo para criar ribbons no Access
Vídeo - Controle personalizado de Acesso de Usuários
Vídeo - Aprenda sobre filtragens
Vídeo - Segurança máxima, usando o OPEN
Uma ajuda para quem está começando um negócio ou um projeto
Integrando o Access com Servidor MySQL - Introdução
Desabilitando a faixa(ribbon) superior do Access
Vídeo - Programação de relatórios - Parte 1
Como carregar o seu menu sem que ele vá para lista de suplementos
Adquira o kit UsandoAccess e aprenda em alta velocidade
|
11 comentários Wilson Roberto Vasques Nunes 25/07/2023 18:36:53 Parabéns aos envolvidos. Função muito útil. A utilizei em meu projeto com algumas modificações: inclui os feriados da cidade de São Paulo, quarta-feira de cinzas e 09 de julho; incorporei a função que calculava feriados móveis dentro na função principal. Renomeei a mesma como getNextWorkday e acabei criando um outra que a usa batizada de isWorkday. Descobri estudando um pouco mais a fundo que o algoritmo utilizado tem nome. Chama-se algoritmo de Meeus/Jones/Butcher do livro "Astronomical Algorithms". https://pt.wikipedia.org/wiki/C%C3%A1lculo_da_P%C3%A1scoa Leandro Barbosa 15/06/2023 04:29:53 Passei por essa necessidade num modo mais amplo. Aqui onde trabalho, somos uma regional, temos a nossa cidade e mais 44 outras cidades para gestionar. Os serviços executados pela empresa terceirizada tem seus prazos de vencimento e esses não podem ser cravados em finais de semana e feriados nacionais ou municipais. Cada cidade além dos feriados nacionais tem seus próprios feriados. Dessa forma se fez necessário criar uma tabela onde cada coluna representa uma cidade e os valores das colunas são as datas que não podem ser contadas. Os serviços tem cada um o seu prazo de execução em horas ou dias. Precisei criar um esqueleto de SQL que buscava o código da cidade no argumento da função. E precisei converter as datas em números longos, porque o sql estava confundindo as datas e com exemplo transformando 01/04/2018 e 04/01/2018. Global dtCrit As Date Global intLocal As Integer Global lngData As Long Public Function PrazoFinal(iLocal As Integer, dataP As Date, sPrazo As String) As Date On Error Resume Next Dim j As Integer Dim cont As Integer Dim d As Integer Dim strHora As String intLocal = iLocal cont = 0 j = 0 Do If Right(sPrazo, 1) = "h" Then 'Se o prazo do serviços for em horas PrazoFinal = DateAdd("h", 4, dataP) 'Adiciona 4 horas à Data e Hora do protocolo If CLng(Now) <= 43281 Then PrazoFinal = DateAdd("n", 30, PrazoFinal) 'Adiciona mais 30 minutos End If Exit Function 'Sai da função End If j = j + 1 'Adiciona mais um ao contador para acréscimo de dias na data e hora do protocolo strHora = Format(dataP, "hh:mm:ss") 'Pega a hora, minuto e segundo do protocolo dtCrit = Format(DateAdd("d", j, dataP), "dd/mm/yyyy") 'Cria um critério para a função fncVerif com a data do protocolo + 1 dia lngData = CLng(dtCrit) 'Tranforma a data em um número longo If fncVerif = 0 Then 'Se a função retornar Zero, quer dizer que encontrou um dia útil PrazoFinal = dtCrit & " " & strHora 'Adiciona esse dia ao prazo final cont = cont + 1 'Adiciona mais 1 ao contador de comparação do Loop While End If Loop While cont < Int(Left(sPrazo, 2)) 'Enquanto o contador for menos que o prazo em dias do serviço, ele continuará repetindo If CLng(PrazoFinal) <= 43281 Then PrazoFinal = DateAdd("h", 8, PrazoFinal) 'Adiciona mais 8 horas End If End Function Function fncVerif() As Long On Error Resume Next Dim dbVerif As DAO.Database Dim rsVerif As DAO.Recordset Dim strVerif As String fncVerif = 0 strVerif = "SELECT CLng([" & intLocal & "]) AS DataLng" & _ " FROM TabDatasAbono" & _ " WHERE CLng([" & intLocal & "])=" & lngData Set dbVerif = CurrentDb() Set rsVerif = dbVerif.OpenRecordset(strVerif) fncVerif = rsVerif!DataLng Set dbVerif = Nothing dbVerif.Close Set rsVerif = Nothing rsVerif.Close End Function Marlos Bianna 05/03/2023 09:49:25 Excelente dica. Allan Bezerra 27/10/2022 16:28:15 Boa Tarde Professor ! Achei interessante o modulo e ate estou precisando executá-lo... porém não consegui entender o final da função. Como poderíamos adquirir este material. att Allan Bezerra 11 9 5530-5465 allanbezerra28@gmail.com Miguel Oliveira 07/04/2022 04:43:08 Obrigado, Já postei no forum Avelino Sampaio 06/04/2022 14:43:23 Miguel, se inscreva no nosso fórum e nos forneça mais detalhes do que deseja: http://www.redeaccess.com.br Aguardamos Miguel Oliveira 06/04/2022 14:36:06 Mestre Avelino Obrigado pelo Tutorial. Muito Bom! Preciso que ajuste também a hora a um determinado horário. Será possível? Decio 14/05/2021 09:01:37 Muito bom o conteúdo! Parabéns. Estou com uma dúvida: neste exemplo os feriados estão salvos no código. Mas é possível que a função busque a tabela de feriados em uma tabela? Assim eles podem ser personalizados ou mesmo podemos ter feriados de regiões diferentes mlops 12/05/2021 17:14:59 Sensacional Mestre Avelino. Abs Marcio Melo 10/04/2021 15:07:24 Muito bom esse artigo que aborda de forma clara as datas de feriados fixos e móveis, esse lance de data e hora no access para mim sempre foi maior dor de cabeça, mas pelo motivo das horas que só vão até 24:00h. Essa semana no meu trabalho estou montando prestação de contas e nela eu utilizo muito o campo de horas e a maior dificuldade é levar para o gráfico do formulário Dinâmico que não consigo, mas eu saio pelo gráfico do relatório que exibe o somatório das horas no formato maior que 24:00, deixo aqui como dica de futuros artigos. Sou mais Brasil! Marcelo David 08/04/2021 11:15:22 Excelente dica e desafio muito muito bom! Pena que que estou tão "enrolado" com umas coisas aqui que me,impedem de nesse momento tentar resolver! Parabéns pelo conteúdo cada vez melhor Avelino! |
