CODICE

Option Compare Database
Option Explicit

' VERIFICA SE LA DATA E' UN GIORNO FESTIVO IN ITALIA
Public Function Festivo(myDate As Date) As Boolean
   Select Case myDate
      '1. GENNAIO NUOVO ANNO
      Case DateSerial(year(myDate), 1, 1)
          Festivo = True
          
      '6.GENNAIO - EPIFANIA
      Case DateSerial(year(myDate), 1, 6)
          Festivo = True

      '25. APRILE - LIBERAZIONE
      Case DateSerial(year(myDate), 4, 25)
          Festivo = True

      '1. MAGGIO FESTA LAVORATORI
      Case DateSerial(year(myDate), 5, 1)
          Festivo = True
          
      '2. GIUGNO FESTA DELLA REPUBBLICA
      Case DateSerial(year(myDate), 6, 2)
          Festivo = True
          
      'PASQUA
      Case Easter(year(myDate))
          Festivo = True
          
      'LUNEDI DI PASQUA
      Case Easter(year(myDate)) + 1
          Festivo = True
                      
      '15. AGOSTO
      Case DateSerial(year(myDate), 8, 15)
          Festivo = True
                      
      '1. NOVEMBRE - TUTTI I SANTI
      Case DateSerial(year(myDate), 11, 1)
          Festivo = True
          
      '8. DICEMBRE - IMMACOLATA CONCEZIONE
      Case DateSerial(year(myDate), 12, 8)
          Festivo = True
          
      '25. DICEMBRE - NATALE
      Case DateSerial(year(myDate), 12, 25)
          Festivo = True
          
      '26. DICEMBRE - SANTO STEFANO
      Case DateSerial(year(myDate), 12, 26)
          Festivo = True

      ' DATE DI FESTIVITA' LOCALI(PATRONO Ecc...)
      'Case DateSerial(year(myDate), nn, nn)
      ' Festivo = True
      '
      ' Per rendere più flessibile la parametrizzazione
      ' di Festività LOCALI si potrebbe usare una Tabella
      ' e recuperare il RS con la Data...!
      ' Case ELSE
          ' Dim rs as DAO.Recordset
          ' sSQL="SELECT * FROM Tb_FesteLocali " & _
          ' "WHERE Data=#" & Format$(myDate,"yyyymmdd") & "#"
          ' set rs=DbEngine(0)(0).OpenRecordset(sSQL, _
          ' dbOpenDynaset,dbReadOnly)
          ' ' Se il rs è vuoto significa che la data non è inserita
          ' come FESTIVITA'
          ' Festivo=NOT rs.Eof
          ' rs.Close
          ' Set rs=Nothing
   End Select
End Function

' CALCOLO DELLA PASQUA
Function Easter(year As Integer) As Date
   Dim d As Integer
   d = (((255 - 11 * (year Mod 19)) - 21) Mod 30) + 21
   Easter = DateSerial(year, 3, 1) + d + (d > 48) + 6 - _
   ((year + year \ 4 + d + (d > 48) + 1) Mod 7)
End Function