Calendario su più fogli

Di seguito il codice per generare un file contenente 12 fogli (uno per mese) con settati

  • weekend;
  • festività nazionali (italiane);
  • santo patrono;
  • Pasqua;

A vostro piacimento potete inserire ulteriori festività. In esecuzione viene chiesto l'anno di cui deve generare il calendario, ovviamente il patrono sarà compito vostro inserirlo corretto

Option Base 1
Dim nYear As Integer
Sub lfValur()
    Dim holyD() As Boolean
    nYear = CInt(InputBox("Anno:", "Select year"))
    For i = 1 To 12
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = StrConv(MonthName(i, False), vbProperCase)
        lfDayFiller (i)
    Next
End Sub
Function lfDayFiller(lfMese As Integer)
    Dim i, z As Byte
    Dim dElab, dEaster As Date
    Dim nameM As String
    'dayM numero di giorni nel mese valutato
    dayM = DaysInMonth(DateSerial(nYear, lfMese, 1))
    ReDim holyD(dayM)
    dElab = DateSerial(nYear, lfMese, 1)
    For i = 1 To dayM
        'setto i weekend
        If Weekday(dElab, 2) = 6 Or Weekday(dElab, 2) = 7 Then
            holyD(i) = True
        Else
            holyD(i) = False
        End If
        dElab = dElab + 1
    Next
    'controllo pasqua
    dEaster = Pasqua(nYear)
    If Month(dEaster) = lfMese Then
        holyD(Day(dEaster)) = True
        holyD(Day(dEaster) + 1) = True 'lunedì dell'angelo
    End If
    Select Case lfMese
        Case 1
            '1 gennaio Capodanno
            '6 gennaio Epifania
            holyD(1) = True
            holyD(6) = True
        Case 2
        Case 3
        Case 4
            '25 aprile Liberazione dal ...
            holyD(25) = True
        Case 5
            '1 maggio Festa del lavoro
            holyD(1) = True
        Case 6
            '2 giugno Festa della Repubblica
            holyD(2) = True
        Case 7
        Case 8
            '15 agosto Assunzione
            holyD(15) = True
        Case 9
        Case 10
        Case 11
            '1 novembre Ognissanti
            '3 novembre S.Giusto
            holyD(1) = True
            holyD(3) = True
        Case 12
            '8 dicembre Immacolata
            '25 dicembre Natale
            '26 dicembre Santo Stefano
            holyD(8) = True
            holyD(25) = True
            holyD(26) = True
    End Select
    'Inserisco i gg
    For i = 1 To dayM
        If holyD(i) = True Then
            Range(Cells(i , 1), Cells(i, 1)).Select
            With Selection.Interior
                .Pattern = xlLightUp
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -4.99893185216834E-02
               .PatternTintAndShade = 0
           End With
        End If
        Cells(i , 1).Value = DateSerial(nYear, lfMese, i)
    Next
    Range("A1:A31").Select
    Selection.NumberFormat = "m/d/yyyy"
    Columns("A:A").Select
    Columns("A:A").EntireColumn.AutoFit
    'Cells(1, 1).Select
End Function
Function DaysInMonth(MyDate As Date) As Long
    Dim NextMonth As Date
    Dim EndOfMonth As Date
    NextMonth = DateAdd("m", 1, MyDate)
    EndOfMonth = NextMonth - DatePart("d", NextMonth)
    DaysInMonth = DatePart("d", EndOfMonth)
End Function
Public Function Pasqua(ByVal anno As Integer) As Date
   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
'http://it.wikipedia.org/wiki/Calcolo_della_Pasqua