Fogli Calendario

Stato
Chiusa ad ulteriori risposte.

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
22.845
1.865
Como
2011MAC 2016WIN
519
Per chi ne avesse bisogno, la creazione di un file con fogli calendario.

Codice:
Option Explicit
Private Sub Workbook_Open()
  Dim fg As Integer
    Dim i As Integer
    Dim j As Integer
    Dim mese As Integer
    Dim mesi As Variant
    Dim anno As Integer
    Dim bisestile
    Dim messaggio As String
    Dim data
    Dim Pasqua
    Dim Pasquetta
    Dim a%, b%, c%, p%, q%, r%
    On Error GoTo esci
    messaggio = "Scrivi l'anno di cui vuoi ottenere il calendario" & vbCrLf & "Formato 'aaaa'"
    Title = "SCELTA ANNO"
    anno = InputBox(messaggio, Title)
    On Error Resume Next
    If Sheets.Count = 12 Then Exit Sub
    For fg = 1 To 12
        mesi = Array("Gennaio", "Febbraio", "Marzo", "Aprile", _
        "Maggio", "Giugno", "Luglio", "Agosto", "Settembre", _
        "Ottobre", "Novembre", "Dicembre")
        ActiveSheet.Name = mesi(fg - 1)
        If fg = 12 Then
            fg = 1
            GoTo skip
        End If
        Sheets.Add After:=Sheets(Sheets.Count)
    Next
skip:       For fg = 1 To Sheets.Count
    If fg = 1 Or fg = 3 Or fg = 5 Or fg = 7 _
    Or fg = 8 Or fg = 10 Or fg = 12 Then
    mese = 31
ElseIf fg = 4 Or fg = 6 Or fg = 9 Or fg = 11 Then
mese = 30
ElseIf fg = 2 And ((anno Mod 4) = 0 And (anno Mod 100)) Or (anno Mod 400) = 0 Then
    mese = 29
ElseIf fg = 2 And ((anno Mod 4) <> 0 Or (anno Mod 100)) Or (anno Mod 400) <> 0 Then
    mese = 28
End If


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)
Pasquetta = Pasqua + 1
j = 1
For i = 1 To mese
    Sheets(fg).Columns("A:A").AutoFit
    Sheets(fg).Cells(i, 1) = fg & "/" & j & "/" & anno
    If Application.WorksheetFunction.Weekday(Sheets(fg).Cells(i, 1)) = 1 Or _
    Sheets(fg).Cells(i, 1) = "01/01/" & anno Or Sheets(fg).Cells(i, 1) = "06/01/" & anno Or _
    Sheets(fg).Cells(i, 1) = "25/04/" & anno Or Sheets(fg).Cells(i, 1) = "01/05/" & anno Or _
    Sheets(fg).Cells(i, 1) = "02/06/" & anno Or Sheets(fg).Cells(i, 1) = "15/08/" & anno Or _
    Sheets(fg).Cells(i, 1) = "01/11/" & anno Or Sheets(fg).Cells(i, 1) = "08/12/" & anno Or _
    Sheets(fg).Cells(i, 1) = "25/12/" & anno Or Sheets(fg).Cells(i, 1) = "26/12/" & anno Or _
    Sheets(fg).Cells(i, 1) = Pasquetta Then
    Sheets(fg).Cells(i, 1).Interior.ColorIndex = 3
    Sheets(fg).Cells(i, 1).Font.ColorIndex = 2
ElseIf Application.WorksheetFunction.Weekday(Sheets(fg).Cells(i, 1)) = 7 Then
    Sheets(fg).Cells(i, 1).Interior.ColorIndex = 44
End If
j = j + 1
Sheets(fg).Cells(i, 1) = Format(Sheets(fg).Cells(i, 1), "dddd dd/mm/yyyy")
Next
Next
[COLOR=#008000]'Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"[/COLOR]
esci:
End Sub
 

Allegati

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
22.845
1.865
Como
2011MAC 2016WIN
519
E va bene ... mettiamoci pure il Santo patrono ... però basta così non vorrai esagerare con le feste!!! Lingua_lingua
 

Allegati

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
22.845
1.865
Como
2011MAC 2016WIN
519
Quando lo avvii compare una UserForm (come in immagine) devi compilarla con ANNO e SANTO PATRONO e poi lanciarla
(se non ti interessa avere in rosso la festività del Santo patrono, lascia la relativa TextBox vuota)

 

MastroLindo

Utente abituale
12 Aprile 2018
149
18
venezia
EXCEL 2016
0
Scusami ges erroneamente avevo disabilitato tutte le macro. Sono andato su File->Opzioni->Centro di protezione->Impostazioni delle macro->Disabilita tutte le macro con notifica. Ho ripristinato tutto.
Ottimo lavoro.:applausi: Funziona perfettamente.
 
Stato
Chiusa ad ulteriori risposte.

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!