Il file ricevuto e non pubblicato per motivi di privacy
aveva 13 fogli: (1 Generale e 12 con il nome mese abbreviato: GEN, FEB, etc)
Metto a disposizioni, per eventuali altri utenti, la macro utilizzata che crea il calendario-orario lavoro come richiesto
- Codice: Seleziona tutto
Public Anno, Riga As Integer, Foglio As String
Sub Creafogli()
DataI = DateSerial(Anno, "01", "01")
DataF = DateSerial(Anno, "12", "31")
Dim Ora1, Ora2 As Date
Ora2 = TimeSerial(0, 30, 0)
MFoglio = ""
For DD = DataI To DataF
Foglio = Format(DD, "mmm")
If MFoglio <> Foglio Then
Riga = 4
Worksheets(Foglio).Range("A2").Value = Format(DD, "mmmm")
Worksheets(Foglio).Range("A4:C600").ClearContents
Worksheets(Foglio).Range("B4:B600").Font.ColorIndex = 1
Worksheets(Foglio).Range("B4:B600").Interior.ColorIndex = xlNone
Worksheets(Foglio).Select
MFoglio = Foglio
End If
Worksheets(Foglio).Range("A" & Riga).Value = Format(DD, "d")
Worksheets(Foglio).Range("B" & Riga).Value = Format(DD, "ddd")
If Format(DD, "ddd") <> "dom" And Format(DD, "ddd") <> "sab" Then
Ora1 = TimeSerial(8, 30, 0)
For RR = Riga To Riga + 17
Worksheets(Foglio).Range("C" & RR).Value = Ora1
Ora1 = Ora1 + Ora2
If Ora1 = "13:30:00" Then Ora1 = TimeSerial(14, 0, 0)
Next RR
Riga = Riga + 18
Else
Riga = Riga + 1
End If
Next DD
Call Form1
Worksheets("TOTALE ANNO").Select
End Sub
Mentre per la formattazione dei fogli-mese è stata usata questa macro (richiamata dalla precedente)
- Codice: Seleziona tutto
Sub Form1()
For FF = 1 To Worksheets.Count
If Sheets(FF).Name <> "TOTALE ANNO" Then
Sheets(FF).Select
UR = Range("C5").CurrentRegion.Rows.Count
Range("H4:J600").Interior.ColorIndex = xlNone
Range("A4:A600").Interior.ColorIndex = xlNone
Range("A4:O600").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A4:O" & UR).Select
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
Range("A4:B" & UR).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A4:B" & UR).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
For Riga = 4 To UR
Festivo = 0
If Worksheets(FF).Range("B" & Riga).Value <> "dom" And Worksheets(FF).Range("B" & Riga).Value <> "sab" Then
Worksheets(FF).Range("B" & Riga + 1 & ":B" & Riga + 17).Interior.ColorIndex = 15
Festivo = 0
End If
If Worksheets(FF).Range("B" & Riga).Value = "dom" Then
Worksheets(FF).Range("B" & Riga).Font.ColorIndex = 3
Worksheets(FF).Range("B" & Riga).Font.FontStyle = "Grassetto"
Festivo = 1
End If
If Worksheets(FF).Range("B" & Riga).Value = "sab" Then
Worksheets(FF).Range("B" & Riga).Font.ColorIndex = 10
Festivo = 1
End If
Range("A" & Riga - 1 & ":O" & Riga - 1).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
If Festivo = 0 Then Riga = Riga + 17
Next Riga
Range("H4:J" & UR).Interior.ColorIndex = 37
Range("A4:A" & UR).Interior.ColorIndex = 11
Range("A4:A" & UR).Font.Bold = True
Range("A4:A" & UR).Font.ColorIndex = 2
Range("A4:A" & UR).HorizontalAlignment = xlCenter
Range("A1").Select
End If
Next FF
End Sub
Per attivare la macro principale è stato usato Il Worksheet_Change del foglio "TOTALE ANNO" (Generale)
- Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$J$5" Then Exit Sub
Risp = MsgBox("Attenzione sarà ricreato il calendario per l'anno digitato, proseguo? ", vbYesNo)
If Risp = 6 Then
Anno = Target
If Anno > Year(Now) + 10 Or Anno < Year(Now) - 10 Then '<<<<< aggiunte queste quattro righe controllo Anno entro il range
MsgBox "Anno fuori range previsto (+/- 10 anno attuale)" '<<< agg
Exit Sub '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< agg
End If '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< agg
Application.ScreenUpdating = False
Application.Calculation = xlManual
Call Creafogli
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End Sub
@Nicolami
Se vuoi avere un controllo sull'anno digitato devi aggiungere le quattro righe dove indicato nell'ultimo codice Worksheet_Change
Questo evita di processare la macro nel caso in cui l'anno digitato va oltre il range previsto di + o - 10 anni rispetto all'anno attuale.
Ciao