Respondi no forum do Tomaz as duas solicitações que pediu, agora a demanda e outra que não está clara, é difícil entender o que pretende.
O ideal seria ter exposto de primeira a sua intenção. E desanimador
Reinaldo desculpe se não fui claro, mas eu te agradeço muito pelo que fez por mim, e ta legal o que fizeste e ta certinho, o que eu quero agora também é que ao digitar o ano no textbox 1 apareça no textbox 2 a data que cai a pascoa, o carnaval, o corpo crhist, (enfim os feriados móveis) e a a mesma coisa com a função de dias úteis e data futura
eu quero que seja em um mesmo formulário
as funções que faltam são estas
DATA FUTURA
Function DataFutura(DataInicial As Date, DiasUteis As Integer, Optional Estado As NomeEstado) As Date
'criada por Alexandre Neves
'em 2012-05-01
Dim Dias As Integer
DataFutura = DataInicial
For Dias = 1 To DiasUteis
Incrementa:
DataFutura = DateAdd("d", 1, DataFutura)
If FeriadoBrasileiro(DataFutura, Estado) Or Weekday(DataFutura) = 1 Or Weekday(DataFutura) = 7 Then GoTo Incrementa
Next
End Function
DIAS UTEIS
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
PASCOA
Function PascoaB(intAno As Integer) As Date
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 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
Postado : 23/09/2017 12:21 pm