Da notare, però, che il nome del mese non viene aggiunto ancora, perché se ne occuperà la routine successiva per l'aggiunta delle date. Il codice è questo:
Private Sub scriviIntestazioni()
'ALTEZZA GENERALE DELLE RIGHE
Cells.Select
Selection.RowHeight = 12
'AGGIUNTA DELL'INTESTAZIONE RIGA 1
Range(Cells(Riga, Colonna), Cells(Riga, Colonna + 3)).Select
Selection.Merge
Selection.RowHeight = 17
Selection.VerticalAlignment = xlCenter
Selection.HorizontalAlignment = xlCenter
Selection.Font.Bold = True
Selection.FormulaR1C1 = "GUARDIA MEDICA AREA FUNZIONALE OMOGENEA"
Riga = Riga + 1
'AGGIUNTA DELL'INTESTAZIONE RIGA 2
Range(Cells(Riga, Colonna), Cells(Riga, Colonna + 3)).Select
Selection.Merge
Selection.RowHeight = 17
Selection.VerticalAlignment = xlCenter
Selection.HorizontalAlignment = xlCenter
Selection.Font.Bold = True
Selection.FormulaR1C1 = "MEDICINA-CARDIOLOGIA"
Selection.Font.ColorIndex = 48
Riga = Riga + 1
'SCRIVE LE PRIME 2 RIGHE DELLA TABELLA
Columns(Colonna).HorizontalAlignment = xlLeft
With Cells(Riga, Colonna)
.FormulaR1C1 = "DATA"
.ColumnWidth = 10
.HorizontalAlignment = xlCenter
End With
With Cells(Riga, Colonna + 1)
.FormulaR1C1 = "Nominativo turno"
.ColumnWidth = 30
.HorizontalAlignment = xlCenter
End With
With Cells(Riga, Colonna + 2)
.FormulaR1C1 = "Unità Operativa"
.ColumnWidth = 20
.HorizontalAlignment = xlCenter
End With
With Cells(Riga, Colonna + 3)
.FormulaR1C1 = "Nominativo turno"
.ColumnWidth = 30
.HorizontalAlignment = xlCenter
End With
Riga = Riga + 1
With Cells(Riga, Colonna + 1)
.FormulaR1C1 = "08.00 - 20.00"
.ColumnWidth = 30
.HorizontalAlignment = xlCenter
End With
With Cells(Riga, Colonna + 2)
.FormulaR1C1 = ""
.ColumnWidth = 20
.HorizontalAlignment = xlCenter
End With
With Cells(Riga, Colonna + 3)
.FormulaR1C1 = "20.00 - 8.00"
.ColumnWidth = 30
.HorizontalAlignment = xlCenter
End With
Riga = Riga + 1
End Sub
...tutto lavoro bruto e ripetitivo, niente di particolare da commentare, ad eccezione del fatto che la variabile Riga aumenta ogni volta che il programma passa a sistemare la riga successiva.La variabile è definita a livello di modulo, così sarà lasciata, per le routines successive, già modificata da questa routine.
La seconda routine si chiama aggiuntaDate, e serve ad aggiungere le date per creare il calendario del mese.
E' ovvio che si serve delle variabili locali Mese e Anno che sono state eguagliate ai valori passati come parametri dalla routine che aggiungeva il foglio, nella quale è stata calcolata la data.
Private Sub aggiuntaDate()
'stabiliamo la data del mese
Dim Dat As Date, primaData As Date
Dat = CDate("01/" & Mese & "/" & Anno)
With Cells(Riga - 1, Colonna)
.FormulaR1C1 = MonthName(Mese)
.Font.Bold = True
End With
Do While Month(Dat) = Mese
With Cells(Riga, Colonna)
.FormulaR1C1 = Day(Dat)
If WeekdayName(Weekday(Dat, vbUseSystemDayOfWeek)) = "domenica" Then .FormulaR1C1 = .FormulaR1C1 & " D"
.Font.Bold = True
End With
Dat = Dat + 1
Riga = Riga + 1
Loop
End Sub
Dichiara una variabile locale Dat di tipo Date, e un'altra chiamata primaData, sempre di tipo Date.Ricostruisce la data del primo giorno del mese successivo dai valori di mese e anno, e la pone nella variabile Dat.
Ora, credo di aver fatto un lavoro un po' cervellotico: innanzitutto la variabile primaData deve essere uno di quei residui di un qualche procedimento cui avevo pensato prima, in quanto mi sembra completamente inutilizzata in tutta la routine.
Provo a eliminarla... Private Sub aggiuntaDate() 'stabiliamo la data del mese Dim Dat As Date Dat = CDate("01/" & Mese & "/" & Anno) ... ...e come avevo capito già, funziona ugualmente!
Ma adesso mi viene in mente un'altra cosa: anziché passare, quando chiamo la prima routine del modulo, mese e anno, non potrei passare come un unico parametro direttamente la data del mese successivo?
Provo a ingegnarmi in tal senso...
No, non è che poi il codice si semplifichi più di tanto, sta bene così...
With Cells(Riga - 1, Colonna)
.FormulaR1C1 = MonthName(Mese)
.Font.Bold = True
End With
La riga del foglio su cui ci troviamo, indicata dalla variabile di modulo Riga, avanzata dalla routine precedente, è la quinta.Ma dobbiamo posizionare il nome del mese su una cella della quarta riga, per cui riduciamo momentaneamente il valore di Riga per posizionare il nome del mese al posto dovuto.
Quindi...
Do While Month(Dat) = Mese
With Cells(Riga, Colonna)
.FormulaR1C1 = Day(Dat)
If WeekdayName(Weekday(Dat, vbUseSystemDayOfWeek)) = "domenica" Then .FormulaR1C1 = .FormulaR1C1 & " D"
.Font.Bold = True
End With
Dat = Dat + 1
Riga = Riga + 1
Loop
Finché il mese della data è uguale al nome del mese che abbiamo memorizzato nella variabile Mese, scriviamo il numero del giorno (Day(Dat)) nella prima colonna.La riga:
If WeekdayName(Weekday(Dat, vbUseSystemDayOfWeek)) = "domenica" Then .FormulaR1C1 = .FormulaR1C1 & " D"serve a ad aggiungere la D nel caso in cui il giorno sia domenica (come da modello datomi).
A ogni aggiunta di giorno si aumenta di un giorno la data, e il numero di riga, in modo che aumentando ogni riga aumenti il giorno del mese, fin quando, come specificato sopra, il mese non cambi (month(Dat = Mese) rispetto a quello memorizzato nella variabile.
A questo punto, il processo finisce.
La routine successiva si chiama creazioneGriglia
Private Sub creazioneGriglia()
'CREAZIONE DELLA GRIGLIA COI BORDI
Range(Cells(primaRiga + 2, primaColonna), Cells(Riga, primaColonna + 3)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
Qui è successo qualcosa di singolare: analizziamo le prime righe:
Private Sub creazioneGriglia() 'CREAZIONE DELLA GRIGLIA COI BORDI Range(Cells(primaRiga + 2, primaColonna), Cells(Riga, primaColonna + 3)).Select ...Ecco, qui ho delle variabili che ho eliminato, ossia primaRiga e primaColonna.
Mancando queste, mi si genera un errore, che però non appariva, ma semplicemente il programma non mi caricava il foglio col calendario del mese.
Perché?
Eseguendo passo-passo con F8 il programma, ho visto che da questa riga il flusso del programma passava direttamente alla routine aggiungiFoglio nella sezione di gestione dell'errore che elimina il foglio:
X: 'gestione dell'errore di tentata rinominazione del foglio: elimina il foglio senza suscitare avvisi di eliminazione.
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End Sub
eliminandomi il foglio.Questo perché, essendo tutte queste routines chiamate dalla routine aggiungiFoglio, sono soggette tutte alla clausola On Error GoTo X, e quindi l'errore non mi appariva ma veniva gestito da quella istruzione con eliminazione del foglio.
La griglia deve essere creata nel Range che va dalla cella che sta alla terza riga e prima colonna, per terminare in basso a destra con la cella che sta all'ultima riga e quarta colonna.
Ecco quindi che, per ovviare all'inconveniente di prima, trasformo così il codice:
Range(Cells(3, 1), Cells(Riga, 4)).Selecteliminando i nomi delle variabili che non esistono più.
Il resto:
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
è tutto lavoro bruto di creazione delle linee, copiato pedissequamente dalle macro generate automaticamente, su cui non bisogna fare un granché di lavoro intellettuale.Unica cosa notevole, che il valore di Riga, essendo stato aumentato a uno più della cella con l'ultimo giorno, è stato lasciato così, creando uno spazio vuoto sotto l'ultimo giorno, semplicemente per rispettare la similitudine con il foglio originale che mi è stato consegnato come modello.
Andiamo alla scritta di coda con la routine scrittaDiCoda
Private Sub scrittaDiCoda() Riga = Riga + 2 Range(Cells(Riga, primaColonna), Cells(Riga, primaColonna + 3)).Select Selection.Merge Selection.RowHeight = 35 Selection.VerticalAlignment = xlTop Selection.WrapText = True Selection.FormulaR1C1 = "N.B. Gli eventuali cambi turno di Guardia Medica AFO devono essere comunicati, ai fini di riscontro, alla scrivente Direzione Sanitaria, sig.ra XXXXX XXXXXX, 38XXX fax 38XXX" Cells(1, 5).Select End SubAumento di 2 il numero della riga corrente e mi ritrovo ancora una di quelle variabili fantasma, primaColonna, che serve per delimitare le caselle da fondere insieme per ospitare la scritta.
E infatti ottengo ancora l'eliminazione spontanea del foglio sempre per quel gioco di gestione dell'errore.
La sostituisco:
Private Sub scrittaDiCoda() Riga = Riga + 2 Range(Cells(Riga, 1), Cells(Riga, 4)).Select Selection.Merge Selection.RowHeight = 35 Selection.VerticalAlignment = xlTop Selection.WrapText = True Selection.FormulaR1C1 = "N.B. Gli eventuali cambi turno di Guardia Medica AFO devono essere comunicati, ai fini di riscontro, alla scrivente Direzione Sanitaria, sig.ra XXXXX XXXXX, 38XXX fax 38XXX" Cells(1, 5).Select End SubAnche qui, come è successo prima, la prima volta che provo con le variabili sostituite il codice sembra funzionare, ma al secondo tentativo ritorna a mostrare l'eliminazione spontanea del foglio.
Stavolta è dovuto al fatto che le variabili appaiono ancora più sotto nel codice.
Questo non me lo so spiegare.
Bene, adesso c'è la routine copiaMenu, che fa qualcosa di completamente nuovo: copia la lista dei medici di guardia che ho su un foglio che, con l'intenzione di renderlo invisibile, ho chiamato Nascosto:
Sub copiaMenu()
Dim k As Integer
k = primaRiga
Do While Sheets("Nascosto").Cells(k, primaColonna) <> ""
ActiveSheet.Cells(k - primaRiga + scartoMenu + 1, primaColonna + 5).FormulaR1C1 = _
Sheets("Nascosto").Cells(k, primaColonna).FormulaR1C1
ActiveSheet.Cells(k - primaRiga + scartoMenu + 1, primaColonna + 6).FormulaR1C1 = _
Sheets("Nascosto").Cells(k, primaColonna + 1).FormulaR1C1
k = k + 1
Loop
With ActiveSheet
With .Cells(primaRiga + scartoMenu - 1, primaColonna + 5)
.Interior.ColorIndex = 6
.FormulaR1C1 = "NOME"
.HorizontalAlignment = xlCenter
End With
With .Cells(primaRiga + scartoMenu - 1, primaColonna + 7)
.Interior.ColorIndex = 8
.FormulaR1C1 = "GIORNO"
End With
With .Cells(primaRiga + scartoMenu - 1, primaColonna + 8)
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
.FormulaR1C1 = "NOTTE"
End With
.Columns(6).ColumnWidth = 26
With .Columns(7)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
With .Columns(8)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
End With
End Sub
Questa è una selva di nomi delle variabili che ho eliminato!Non so nemmeno se le ho evidenziate tutte in rosso, perché sono ripetute troppe volte.
Sostituiamole...
Sub copiaMenu()
Dim k As Integer
k = 1
Do While Sheets("Nascosto").Cells(k, 1) <> ""
ActiveSheet.Cells(k - 1 + scartoMenu + 1, 1 + 5).FormulaR1C1 = _
Sheets("Nascosto").Cells(k, 1).FormulaR1C1
ActiveSheet.Cells(k - 1 + scartoMenu + 1, 1 + 6).FormulaR1C1 = _
Sheets("Nascosto").Cells(k, 1 + 1).FormulaR1C1
k = k + 1
Loop
With ActiveSheet
With .Cells(1 + scartoMenu - 1, 1 + 5)
.Interior.ColorIndex = 6
.FormulaR1C1 = "NOME"
.HorizontalAlignment = xlCenter
End With
With .Cells(1 + scartoMenu - 1, 1 + 7)
.Interior.ColorIndex = 8
.FormulaR1C1 = "GIORNO"
End With
With .Cells(1 + scartoMenu - 1, 1 + 8)
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
.FormulaR1C1 = "NOTTE"
End With
.Columns(6).ColumnWidth = 26
With .Columns(7)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
With .Columns(8)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
End With
End Sub
Mi sembra di averle sostituite tutte, ma il programma continua ad eliminare il foglio, e infatti appaiono ancora in un'altra routine...Aggiusto meglio questa routine... C'è anche una variabile che si chiama scartoMenu, la quale l'ho creata sempre nell'ottica di una flessibilità nel posizionamento della tabella.
E' una variabile globale, definita nel modulo delle variabili globali:
Public Const scartoTabella = 4 Public Const scartoMenu = 3 Public Bersaglio As Range Public Const Centralina = "Foglio1"Che faccio, la elimino?
Vediamo di analizzare il codice...
Sub copiaMenu()
Dim k As Integer, z As Integer
k = 1
z = 4
Do While Sheets("Nascosto").Cells(k, 1) <> ""
ActiveSheet.Cells(z, 6).FormulaR1C1 = _
Sheets("Nascosto").Cells(k, 1).FormulaR1C1
ActiveSheet.Cells(z, 7).FormulaR1C1 = _
Sheets("Nascosto").Cells(k, 2).FormulaR1C1
k = k + 1
z = z + 1
Loop
With ActiveSheet
With .Cells(3, 6)
.Interior.ColorIndex = 6
.FormulaR1C1 = "NOME"
.HorizontalAlignment = xlCenter
End With
With .Cells(3, 8)
.Interior.ColorIndex = 8
.FormulaR1C1 = "GIORNO"
End With
With .Cells(3, 9)
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
.FormulaR1C1 = "NOTTE"
End With
.Columns(6).ColumnWidth = 26
With .Columns(7)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
With .Columns(8)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
End With
End Sub
L'ho riscritta completamente perché era scritta con un codice incredibilmente cervellotico, sempre con l'intenzione di posizionare dinamicamente la tabella, cosa del tutto inutile.Ho eliminato la variabile globale scartoMenu, che non serve più.
E funziona egregiamente!
Però avendo appreso una nuova funzionalità di Excel, ossia la possibilità di dare un nome ai ranges, ho ancora dei miglioramenti da fare per eliminare quel codice tipo
ActiveSheet.Cells(z, 6).FormulaR1C1 = _
Sheets("Nascosto").Cells(k, 1).FormulaR1C1
ActiveSheet.Cells(z, 7).FormulaR1C1 = _
Sheets("Nascosto").Cells(k, 2).FormulaR1C1
che facilmente può risultare confusivo.Ma questo lo vedrò in seguito.
C'è poi la routine scorri, che serve per presentare il foglio all'operatore avendo sotto gli occhi tutti i giorni del mese, in modo da poter seguire le modifiche dei turni sull'elenco dei medici.
Sub scorri()
ActiveWindow.SmallScroll Down:=2
End Sub
...copiata dalle Macro automatiche, regolando a 2 il numero di riga al quale far scorrere il foglio.Nessun ragionamento particolarmente intelligente da fare.
L'ultima routine del modulo formattazioneFoglio è impostazioniStampa, che serve per preparare le giuste dimensioni del foglio per la stampa.
Private Sub impostazioniStampa()
'IMPOSTAZIONI PER LA STAMPA
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0)
.PrintArea = "$A$" & primaRiga & ":$D$44"
End With
End Sub
E qui ho copiato ampiamente dalle Macro automatiche, ma mi salta all'occhio che c'è ancora la fantomatica variabile primaRiga.La eliminiamo:
Private Sub impostazioniStampa()
'IMPOSTAZIONI PER LA STAMPA
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0)
.PrintArea = "$A$" & 1 & ":$D$44"
End With
End Sub
Bene: andiamo a provare il tutto, compresa l'anteprima di stampa per saggiare questa ultima routine.
Tutto OK! (che faticaccia!)
Nessun commento:
Posta un commento