Il lavoro che sto per presentare questa volta è un progetto ibrido. Cioè il lavoro eseguito in Excel in parte viene eseguito usando le funzioni proprie di Excel in parte aiutati dal codice VBA.
Per l'occasione presentiamo la preparazione di un semplice calendario. Ma non un calendario piatto, monocromatico, ma con le feste ed i prefestivi colorati.
Quel che vogliamo da questo calendario:
Potrebbe sembrare una banalità o una semplice perdita di tempo o addirittura un'attività ludica. In realtà è un utile esercizio. Ma chi non ha mai avvertito la necessità di gestire un turno, uno scadenziario, un gestore di appuntamenti?
Da questo che sto per presentare questa volta si può fare tutto questo e molto di più.
Iniziamo quindi a costruire un semplice calendario.
Iniziamo dal foglio2
| K | L | M | N | Le formule usate nella colonna K |
|---|---|---|---|---|
| 01/01/2007 | Capodanno | =DATA($H$1;1;1) | ||
| 06/01/2007 | Epifania | =DATA($H$1;1;6) | ||
| 25/04/2007 | Liberazione | =DATA($H$1;4;25) | ||
| 01/05/2007 | Festa del Lavoro | =DATA($H$1;5;1) | ||
| 02/06/2007 | Festa della Repubblica | =DATA($H$1;6;2) | ||
| 15/08/2007 | Ferragosto | =DATA($H$1;8;15) | ||
| 01/11/2007 | Tutti i Santi | =DATA($H$1;11;1) | ||
| 08/12/2007 | Immacolata | =DATA($H$1;12;8) | ||
| 25/12/2007 | Natale | =DATA($H$1;12;25) | ||
| 26/12/2007 | S. Stefano | =DATA($H$1;12;26) | ||
| 22/04/2007 | Festa Patronale | =DATA($H$1;4;22) | ||
| Pasqua | ||||
| Lunedi dell'Angelo |
Attenzione:
Per il momento nella colonna K non verranno le date che ci aspettiamo in quanto la cella H1 è ancora vuota
Ora possiamo passare al Foglio1
Disegnamo due ComboBox:
Le impostazioni da dare alla ComboBox presa dalla Barra dei Moduli
Questa ComboBox porrà nella cella il numero relativo al mese scelto
Le impostazioni da fare alla ComboBox presa dalla Barra Strumenti di controllo
Dovremmo avere una situazione del genere
Se ora si clicca sulla ComboBox dei mesi nella cella F1 del foglio2 verrà scritto il numero relativo al mese scelto
Se si clicca sulla ComboBox degli anni nella cella H1 del foglio2 verrà scritto l'anno scelto
Se andiamo a controllare le date scritte nella colonna K del foglio2 ora possiamo osservare che si sono aggiornate all'anno scelto
La costruzione del calendario sul foglio: parte finale della progettazione
Ora siamo pronti per creare il nostro calendario.
Avremo questa situazione
| =A2 | |
| =DATA(Foglio2!$H$1;Foglio2!$F$1;Foglio2!E1) | =A2 |
Queste formule ci faranno vedere una cosa del genere
| 01/08/2007 | |
| 01/08/2007 | 01/08/2007 |
Ma ancora non ci siamo, perciò continuaiamo col lavoro.
Verremo a trovarci in questa condizione:
| agosto | |
| mercoledì | 01 |
A questo punto selezioniamo le celle A2 e B2 e, quando il cursore assume la forma simile al più (+) trasciniamo la selezione fino alla riga 32. Così facendo visualizzeremo tutti i giorni del mese fino al giorno 31
verremmo a trovarci in questa situazione:
| agosto | ||
| mercoledì | 01 | |
| giovedì | 02 | |
| venerdì | 03 | |
| sabato | 04 | |
| domenica | 05 | |
| lunedì | 06 | |
| martedì | 07 | |
| mercoledì | 08 | |
| ecc. |
Si inizia col risolvere il discorso della Pasqua risolvendo un problema lasciato in sospeso qui sopra
Il calcolo della Pasqua
Ho dovuto girare molto per trovare l'algoritmo per il calcolo della Pasqua e finalmente ho trovato delle spiegazioni alquanto complesse in Wikipedia. Chi volesse approfondire (http://it.wikipedia.org/wiki/Calcolo_della_Pasqua).
Continuando nell'esplorazione mi sono fermato a questo che mi sembra abbastanza semplice.
Perciò in un modulo standard scriveremo questo codice:
Function CercaLaPasqua(Optional ByVal Y As Integer = 2007) As Date
Dim M As Integer, N As Integer, A As Integer, B As Integer, C As Integer
Dim D As Integer, E As Integer
Dim ED As String
M = 24: N = 5
A = Y Mod 19
B = Y Mod 4
C = Y Mod 7
D = (19 * A + M) Mod 30
E = (2 * B + 4 * C + 6 * D + N) Mod 7
ED = 22 + D + E
If ED <= 31 Then
ED = ED & "/03/" & Y
Else
ED = D + E - 9 & "/04/" & Y
End If
CercaLaPasqua = CDate(ED)
End Function
Nel Foglio di lavoro questa funzione si usa così:
=cercalapasqua(H1)
Nel codice VBA la funzione viene richiamata con:
Scritta questa funzione possiamo completare la nostra tabella delle feste che sta nel Foglio2
| K | L | M | N | Le formule usate nella colonna K |
|---|---|---|---|---|
| 01/01/2007 | Capodanno | =DATA($H$1;1;1) | ||
| 06/01/2007 | Epifania | =DATA($H$1;1;6) | ||
| 25/04/2007 | Liberazione | =DATA($H$1;4;25) | ||
| 01/05/2007 | Festa del Lavoro | =DATA($H$1;5;1) | ||
| 02/06/2007 | Festa della Repubblica | =DATA($H$1;6;2) | ||
| 15/08/2007 | Ferragosto | =DATA($H$1;8;15) | ||
| 01/11/2007 | Tutti i Santi | =DATA($H$1;11;1) | ||
| 08/12/2007 | Immacolata | =DATA($H$1;12;8) | ||
| 25/12/2007 | Natale | =DATA($H$1;12;25) | ||
| 26/12/2007 | S. Stefano | =DATA($H$1;12;26) | ||
| 22/04/2007 | Festa Patronale | =DATA($H$1;4;22) | ||
| 08/04/2007 | Pasqua | =cercalapasqua(H1) | ||
| 09/04/2007 | Lunedi dell'Angelo | =K12+1 |
Finito anche questo lavoro ci possiamo dedicare al resto del lavoro.
Come accennato all'inizioil nostro scopo è quello di:
Questo è quanto faremo nel codice che presento.
Sub Colora()
Dim UltimoGiorno
Dim Forse As Boolean
Dim Intervallo As Range
Dim IntervDate As Range
Dim cAnno, cMese, MeseCorrente
Dim URiga, R, Fest, Colonne
Dim DataCal
With Worksheets("foglio2")
cAnno = .Range("H1")
cMese = .Range("F1")
End With
'viene cercato l'ultimo giorno del mese
UltimoGiorno = DateDiff("d", DateSerial(cAnno, cMese, 1), DateSerial(cAnno, cMese + 1, 1))
'vengono determinati gli intervalli del calendario che sta sul foglio1
'e delle feste che sono nella colonna K del foglio2
With Range("A1").CurrentRegion
Set Intervallo = .Offset(1, 0).Resize(.Rows.Count - 1, 3)
End With
Set IntervDate = Sheets("Foglio2").Range("K1:K13")
'viene cercata l'ultima riga occupata dal calendario
URiga = Intervallo.Rows.Count
'si inizia col cancellare le formattazioni applicate precedentemente
Application.ScreenUpdating = False
With Intervallo
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 1
.Font.Bold = False
.Rows("29:31").EntireRow.Hidden = False
.Columns("C:D").ClearContents
For R = 1 To URiga
' si colorano le domeniche
If Weekday(.Item(R, 1)) = 1 Then
With Range(.Item(R, 1), .Item(R, 3)).Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With Range(.Item(R, 1), .Item(R, 3)).Font
.Name = "Arial"
.FontStyle = "Grassetto"
.ColorIndex = 2
End With
End If
' ora si colorano i sabato
If Weekday(.Item(R, 1)) = 7 Then
With Range(.Item(R, 1), .Item(R, 3)).Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With Range(.Item(R, 1), .Item(R, 3)).Font
.Name = "Arial"
.FontStyle = "Grassetto"
.ColorIndex = 2
End With
End If
Next
'inizia la ricerca delle feste infrasettimanali
For R = 1 To URiga
DataCal = .Item(R, 1)
For Fest = 1 To IntervDate.Rows.Count
If DataCal = IntervDate(Fest, 1) Then
With Range(.Item(R, 1), .Item(R, 3)).Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With Range(.Item(R, 1), .Item(R, 3)).Font
.Name = "Arial"
.FontStyle = "Grassetto"
.ColorIndex = 2
End With
.Item(R, 3) = IntervDate(Fest, 3)
If (R - 1) > 0 And .Item(R - 1, 1).Interior.ColorIndex <> 3 Then
With Range(.Item(R - 1, 1), .Item(R - 1, 3)).Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With Range(.Item(R - 1, 1), .Item(R - 1, 3)).Font
.Name = "Arial"
.FontStyle = "Grassetto"
.ColorIndex = 2
End With
End If
End If
Next
Next
End With
'vengono nascoste le righe che contengoo i giorni eccedenti al mese corrente
If UltimoGiorno <> 31 Then
Intervallo.Rows(UltimoGiorno + 1 & ":" & URiga).EntireRow.Hidden = True
End If
Application.ScreenUpdating = True
End Sub
Il codice può essere migliorabile ma, almeno per il momento sembra svolgere bene il suo compito. Perciò lo lascio così.
Buon lavoro