Facciamo un Planning. - dal 04/09/04 pagina vista: volte

Non ce ne sarebbe bisogno (sui due siti esistono già articoli su come realizzare Planning (o calendari)), ma visto che il vba ci consente spesso di seguire strade diverse per ottenere gli stessi risultati, può essere interessante esaminare altre procedure.

Vogliamo ottenere, su un foglio di lavoro, la colorazione delle celle che corrispondano, in una tabella calendario, ai sabati e alle domeniche.

Avremo così un impatto visivo immediato sui due giorni (sabati e domeniche) presenti per ogni mese dell'intero anno. A cosa può servire? Potremo divertirci per vedere in che giorno (della settimana) , di un determinato anno, cadrà una certa data, e comunque potrà servire a fare pratica con funzioni specifiche su date e/o giorni.

Il risultato che vogliamo ottenere è come questo:

Potremo comunque, anzichè visualizzare il nome dei giorni della settimana (lun, mart, ecc), avere una visione impostata solo sui numeri dei giorni, così:

In entrambi i casi (ottenibili con due diverse routines associate a pulsanti diversi), una volta ottenuto il Planning, potremo scrivere nelle celle delle note che ci ricordino eventuali impegni o appuntamenti, inserendo magari un "commento" anche esteso (dal menù Inserisci/Commento); riconosceremo poi la/le celle con i commenti dal triangolino rosso che appare nell'angolo superiore destro della cella.

Vediamo allora come procedere: intanto abbiamo bisogno di poter variare l'anno di cui vogliamo il Planning. Per questo useremo una InputBox  nella quale digitare l'anno che ci interessa, ed una volta ottenuto l'anno, lo copieremo in una cella del Foglio di lavoro, però in formato data di inizio anno (quindi 01/01/Anno). Questa data ci servirà per generare il nome dei mesi che formano l'anno.  Sotto vediamo la InputBox e la cella B1 dove questa data viene copiata:

Attenzione: nella Cella B1 vediamo solo l'anno (e non l'intera data 01/01/2004) perchè usiamo formattare la cella attraverso la Funzione NumberFormat che ci consente di impostare, dal Vba, il Formato Dati per le celle del foglio di lavoro, ed avremo appunto scelto di visualizzare solo l'anno; ricordo che la scelta della Formattazione Dati in una cella interessa SOLO il modo in cui Excel ci visualizza il dato, ma NON modifica il reale contenuto della cella, che resta (e viene visto da Excel) come data 01/01/2004. Lo stesso sistema useremo anche per visualizzare il nome dei mesi o per visualizzare il nome dei giorni.

Per comodità ho diviso le procedure in routines separate; ovviamente sarà possibile integrarle in una unica routine, oppure chiamarle a fine della seguente routine:

  • Sub Planning()  - le istruzioni provvedono a reperire l'anno tramite InputBox e copiare la data completa di anno nella cella B1, inoltre provvedono ad impostare i mesi nelle celle della riga 3, dalla colonna B (la 2):

Sub Planning()

'sotto: ad ogni cambio di anno faccio pulire le celle dell'area giorni (B4:M4) e tolgo il colore alle 'celle; dobbiamo infatti considerare che l'anno scelto potrà essere un bisestile e quindi varia la 'durata del mese di Febbraio, e che cambieranno i giorni relativi ai sabati e domeniche con le 'conseguenti variazioni dei colori celle
Range("B4:M34").Interior.ColorIndex = xlNone 
'si toglie il colore alle celle
Range("B4:M34").ClearContents 
'si puliscono le celle

Dim M As Integer
Anno = InputBox("SCRIVI L'ANNO")
'la variabile "anno" è il valore scritto nella inputbox
If Anno = "" Then Exit Sub 
'se non scriviamo nulla o annulliamo, usciamo dalla routine

'sotto: ora "componiamo la data che scriviamo nella cella B1; da notare che usiamo la Funzione di 'conversione del tipo di dati "CDate". Siamo così certi che Excel accetterà la stringa come data.
Sheets(1).[B1] = CDate("01/01/" & Anno & "")
Sheets(1).[B1].NumberFormat = "yyyy"
'indi si imposta la formattazione di B1 ad anno a 4 cifre.
 

'sotto: iniziamo ora un ciclo che scriverà nelle celle della riga 3, a partire dalla colonna 2 (la B), i 'nomi dei mesi. Poichè dobbiamo incrementare di un mese alla volta il mese della data iniziale 'posta in B1 (01/01/Anno), dovremo estrarre, con la Funzione Month, il Mese da questa data ed 'aggiungere 1; useremo il contatore M del ciclo For Next che dovrà essere iniziato a 0, in quanto 'dobbiamo ripetere il mese "gennaio" già presente come mese iniziale (01/gen/Anno)
For M = 0 To 11
'sotto: con la variabile "Mese" estraiamo il mese dalla data iniziale ed aggiungiamo il valore 'rappresentato da M
Mese = Month(CDate("01/01/" & Anno & "")) + M

'quindi si riforma la nuova data assegnandola alla variabile "Miadata" usando il F.d.C.d.tipo 'CDate
Miadata = CDate("01/" & Mese & "/" & Anno & "")

'e si assegna Miadata alla cella della riga 3, colonna M + 2 (ad inizio ciclo M è uguale a zero e 'quindi si inizia dalla B); ad ogni Next "M" sarà incrementato di 1
Cells(3, M + 2) = Miadata
Cells(3, M + 2).NumberFormat = "mmm"
'quindi si imposta la formattazione cella a solo mese
Cells(3, M + 2).Font.Bold = True 
'e si rende grassetto il carattere

Next
'Giorni  'se vorremo chiamare le altre routine che vedremo più avanti
'Colora

End Sub

Queste istruzioni ci restituiscono questa situazione (oltre ad avere l'anno in B1, visto sopra):

A questo punto potremo scegliere due possibilità, riempire le celle di ogni mese con il numero dei giorni, o con il nome dei giorni, ho predisposto due routine diversificate, e potremo usare l'una o l'altra, a scelta.

Ho usato per queste due routine la funzione Array (è il mio primo cimento con le matrici, e mi scuso se non sarò preciso nelle spiegazioni). In questo caso, la funzione Array, restituisce ad una variabile X il numero indice rappresentato dalla posizione che un dato elemento possiede all'interno dell'elenco argomenti che compongono la matrice.

L'elenco argomenti è l'argomento della funzione, ed è composto da un elenco delimitato da virgole tra i valori assegnati agli elementi della matrice, e se i valori sono in formato Testo, gli stessi vanno posti tra doppi apici. Esempio:

  • X - nome variabile

  • ("gen", "feb", "mar", "apr", "mag", "giu", "lug", "ago", "set", "ott", "nov", "dic") - argomento della funzione, composto da una serie (elenco argomenti) di nomi (quelli dei mesi) racchiusi tra doppi apici e ognuno separato da una virgola. Questo elenco è la matrice degli argomenti. Abbiamo in questo caso una matrice a 12 elementi (i nomi dei mesi).

Se ora impostiamo questa istruzione:

  • X = Array("gen", "feb", "mar", "apr", "mag", "giu", "lug", "ago", "set", "ott", "nov", "dic")

con l'istruzione B = X(2) otterremo che B sarà uguale all'elemento della matrice rappresentato dal numero che indica (2) la sua posizione all'interno della matrice, quindi sarà uguale a "mar".

L'indice nelle matrici inizia sempre da zero, infatti X(0) sarà uguale a "gen", X(1) sarà uguale a "feb", X(2) sarà uguale a "mar", ecc.. Se vogliamo forzare l'inizio del numero indice di una matrice, possiamo usare l'istruzione (da porsi nella sezione "Generale - Dichiarazioni" del modulo dove risiede la matrice) OptionBase 1; questa istruzione farà iniziare il numero indice della matrice da 1; così avremo che X(2) restituirà "feb".

L'uso di un Array ci serve per identificare quanti giorni assegnare ad ogni mese; useremo quindi un ciclo For Next che equiparando il contatore del ciclo alla variabile dell'Array, riconosca il mese e scelga tramite il Select Case il mese per assegnare il numero giusto di giorni. Comprenderemo pure un controllo if..Then che tramite l'operatore Mod riconosca se l'anno richiesto è bisestile. Vediamo la routine:

  • Sub Giorni()

Sub Giorni()
Dim Mese, Nome

'sotto: ci assicuriamo di reimpostare l'area giorni del Planning a Generale
Range("B4:M34").NumberFormat = "General"

'sotto: -usiamo la variabile "Mese" come vettore della matrice
Mese = Array("gen", "feb", "mar", "apr", "mag", "giu", "lug", "ago", "set", "ott", "nov", "dic")
'sotto: iniziamo il ciclo che tramite il contatore "M" inizi da 1 incrementandosi fino a 12
For M = 1 To 12
'sotto ora usiamo la variabile "Nome" per memorizzare il valore dell'elemento M di Mese
Nome = Mese(M)
'all'inizio Nome contiene "gen" perchè M sarà 1, poi sarà "feb", ecc.ecc, ad 'ogni ciclo M si incrementa di una unità e restituirà il valore corrispondente all'indice matrice

'sotto: ora iniziamo il Select Case impostato sul "Nome" (ora nome del mese)
Select Case Nome


Case "gen", "mar", "mag", "lug", "ago", "ott", "dic"
gg = 1  la variabile gg la iniziamo da 1
For G = 1 To 31 'iniziamo un ciclo interno che "giri" 31 volte
Cells(3 + G, 2) = gg  'la cella riga 3 + G, colonna 2 (colonna dove inizia "gen") sarà = a 1, e via 'così per tutte le colonne che corrispondono ai mesi di 31 giorni
Cells(3 + G, 4) = gg
Cells(3 + G, 6) = gg
Cells(3 + G, 8) = gg
Cells(3 + G, 9) = gg
Cells(3 + G, 11) = gg
Cells(3 + G, 13) = gg
gg = gg + 1
'incrementiamo gg di una unità ad ogni ciclo
Next

'sotto proseguono le istruzioni per i mesi di 30 giorni
Case "apr", "giu", "set", "nov"
gg = 1
For G = 1 To 30
Cells(3 + G, 5) = gg
Cells(3 + G, 7) = gg
Cells(3 + G, 10) = gg
Cells(3 + G, 12) = gg
gg = gg + 1
Next

'ed ora il Caso "feb" che valuterà se fare 28 o 29 giorni
Case "feb"
gg = 1
If Year([b1]) Mod 4 = 0 Then
fmese = 29
Else
fmese = 28
End If
For G = 1 To fmese
Cells(3 + G, 3) = gg
gg = gg + 1
Next
End Select
Next
End Sub

Questa sopra è la ruotine che genera la sequenza di numeri dei giorni per ogni mese, vista nella seconda immagine di questa pagina.

Ora vediamo invece la routine che assegnerà il nome dei giorni (inteso come giorni settimana). Per questo useremo la funzione WeekDay (corrispondente alla funzione GIORNO.SETTIMANA del foglio di lavoro). La funzione richiede come argomento una data, e restituisce un numero che di default indica con 1 (Domenica) e termina con 7 (Sabato). Usando poi la funzione NumberFormat = "ddd" visualizzeremo il nome del giorno anzichè il numero corrispondente. La routine usa anche qui un Array per i nomi dei mesi, e non commento le istruzioni che prevedono comunque il Select Case:

  • Sub GiorniSett()

Sub GiorniSett()
Dim Mese, Nome

Mese = Array("gen", "feb", "mar", "apr", "mag", "giu", "lug", "ago", "set", "ott", "nov", "dic")

For M = 1 To 12
Nome = Mese(M)
 'all'inizio Nome contiene "gen". (non scordarsi di Option Base 1)
Select Case Nome
Case "gen", "mar", "mag", "lug", "ago", "ott", "dic"

For G = 1 To 31
Cells(3 + G, 2) = Weekday((Cells(3, 2) + G) - 1)
Cells(3 + G, 2).NumberFormat = "ddd"
Cells(3 + G, 4) = Weekday((Cells(3, 4) + G) - 1)
Cells(3 + G, 4).NumberFormat = "ddd"
Cells(3 + G, 6) = Weekday((Cells(3, 6) + G) - 1)
Cells(3 + G, 6).NumberFormat = "ddd"
Cells(3 + G, 8) = Weekday((Cells(3, 8) + G) - 1)
Cells(3 + G, 8).NumberFormat = "ddd"
Cells(3 + G, 9) = Weekday((Cells(3, 9) + G) - 1)
Cells(3 + G, 9).NumberFormat = "ddd"
Cells(3 + G, 11) = Weekday((Cells(3, 11) + G) - 1)
Cells(3 + G, 11).NumberFormat = "ddd"
Cells(3 + G, 13) = Weekday((Cells(3, 13) + G) - 1)
Cells(3 + G, 13).NumberFormat = "ddd"

Next
Case "apr", "giu", "set", "nov"

For G = 1 To 30
Cells(3 + G, 5) = Weekday((Cells(3, 5) + G) - 1)
Cells(3 + G, 5).NumberFormat = "ddd"
Cells(3 + G, 7) = Weekday((Cells(3, 7) + G) - 1)
Cells(3 + G, 7).NumberFormat = "ddd"
Cells(3 + G, 10) = Weekday((Cells(3, 10) + G) - 1)
Cells(3 + G, 10).NumberFormat = "ddd"
Cells(3 + G, 12) = Weekday((Cells(3, 12) + G) - 1)
Cells(3 + G, 12).NumberFormat = "ddd"

Next
Case "feb"

If Year([b1]) Mod 4 = 0 Then
fmese = 29
Else
fmese = 28
End If
For G = 1 To fmese
Cells(3 + G, 3) = Weekday((Cells(3, 3) + G) - 1)
Cells(3 + G, 3).NumberFormat = "ddd"

Next
End Select
Next
End Sub

Come già detto all'inizio, ho diviso le routine in 4 procedure per comodità di lettura), ma chi vorrà potrà integrarle in una unica routine. Ora vediamo l'ultima delle quattro, quella per colorare le celle; ho scelto il giallo per evidenziare i sabati ed il rosso per le domeniche. Anche qui useremo la funzione WeekDay, e a secondo se il numero restituito dalla funzione sarà 1 oppure 7, coloreremo la cella del colore scelto. Poichè ho basato queste istruzioni sull'identificazione dei giorni come numero e non come nome giorno, è necessario usare prima di lanciare la Sub Colora(), lanciare la Sub Giorni(). Se lancerete Colora dopo aver lanciato GiorniSett, la routine fallirà l'esatta identificazione. Come pure fallirà se viene lanciata la sub Colora con l'area Planning vuota.

  • Sub Colora()

Sub Colora()
Range("B4:B34").Interior.ColorIndex = xlNone
 'togliamo il colore all'area planning


For col = 2 To 13 
data = Cells(3, col)
finer = Range(Cells(4, col), Cells(4, col).End(xlDown)).Rows.Count
For r = 4 To finer + 3
If Weekday(data + (Cells(r, col) - 1)) = 7 Then
Cells(r, col).Interior.ColorIndex = 6
End If
If Weekday(data + (Cells(r, col) - 1)) = 1 Then
Cells(r, col).Interior.ColorIndex = 3
End If
Next
finer = 0
Next

End Sub

Ho predisposto 4 pulsanti per chiamare le routine in progressione. Ognuno faccia come meglio crede.

 

File consultabile e scaricabile :  Planning2000.zip   20 Kb

Buon Lavoro.

prelevato sul sito www.ennius.altervista.org