Public Function ContaLavorativi(DataIniziale As Date, DataFinale _
As Date, Settimanacorta As Boolean) As Integer
'Autore: Silvio Mazzetto
'Accetta:
' DataIniziale = data iniziale del periodo scelto
' DataFinale = data finale del periodo scelto
' Settimanacorta = True se bisogna considerare la settimana corta
'Restituisce: numero di giorni lavorativi del periodo
'La funzione utilizza Festivo() e Pasqua() usabili anche separatamente
Dim DataDaContare As Date, Conto As Integer
If Not IsDate(DataIniziale) Or Not IsDate(DataFinale) Or DataIniziale > _
DataFinale Then
ContaLavorativi = 0
Exit Function
End If
DataDaContare = DataIniziale - 1
If Settimanacorta Then
Do
DataDaContare = DataDaContare + 1
If Not Festivo(DataDaContare) And WeekDay(DataDaContare) <> 7 Then
Conto = Conto + 1
End IF
Loop Until DataDaContare = DataFinale
Else
Do
DataDaContare = DataDaContare + 1
If Not Festivo(DataDaContare) Then Conto = Conto + 1
Loop Until DataDaContare = DataFinale
End If
ContaLavorativi = Conto
End Function
Public Function Festivo(D As Date) As Boolean
'Autore: Silvio Mazzetto
'Accetta: una data
'Restituisce: True se è un giorno festivo
'Eventualmente inserire anche il Santo Patrono della città
'Modificato da Roberto
Dim Anno As Integer, DayMax As Date, DayMin As Date
Anno = Year(D)
If WeekDay(D) = 1 Then
Festivo = True
Exit Function
End If
If Day(D) = 1 And (Month(D) = 1 Or Month(D) = 5 Or Month(D) = 11) Or _
Day(D) = 6 And Month(D) = 1 Or Day(D) = 25 And (Month(D) = 4 Or _
Month(D) = 12) Or Day(D) = 15 And Month(D) = 8 Or (Day(D) = 8 Or _
Day(D) = 26) And Month(D) = 12 Then
Festivo = True
Exit Function
End If
'intervallo in cui può cadere il Lunedì di Pasqua
DayMax = DateValue("21/4/" & Anno)
DayMin = DateValue("20/3/" & Anno)
If WeekDay(D) = 2 And D <= DayMax And D >= DayMin Then
If D = (Pasqua(Anno) + 1) Then
Festivo = True
Exit Function
End If
End If
Festivo = False
End Function
Public Function Pasqua(Anno As Integer) As Date
'Autore: G.Paolo Bizzaro
'Accetta: anno (4 cifre)
'Restituisce: giorno di Pasqua dell'anno scelto
'Il metodo è valido per tutti gli anni nel Calendario Gregoriano,
'ossia dal 1583 in poi
Dim a%, b%, c%, p%, q%, r%
a = anno% Mod 19: b = anno% \ 100: c = anno% Mod 100
p = (19 * a + b - (b \ 4) - ((b - ((b + 8) \ 25) + 1) \ 3) + 15) Mod 30
q = (32 + 2 * ((b Mod 4) + (c \ 4)) - p - (c Mod 4)) Mod 7
r = (p + q - 7 * ((a + 11 * p + 22 * q) \ 451) + 114)
Pasqua = DateSerial(anno%, r \ 31, (r Mod 31) + 1)
End Function
|