FOGLIO PRESENZE CON ORARIO LAVORATIVO

[nicolami]

Ciao a tutti vi scrivo per un problema con un foglio excel,

ho un pagina excel chiamata "totale anno" in cui inserisco una data qualunque (es. 01/01/2012), automaticamente negli altri 12 fogli (indicati con ciascun mese) compaiono automaticamente i giorni della settimana. Tali giorno si aggiornano automaticamente a seconda della data che inserisco (es 01/01/2012). Vorrei, ora aggiungere il mio orario di lavoro (08:30-13:00/14:00-17:30) scandendolo di mezz'ora, quindi, per ogni giorno di lavoro, quindi, dovrebbero corrispondere 18 righe in cui compare: 08:30 nella prima riga, 09:00 nella seconda ecc..fino alle 17:30...conseguentemente l'orario dovrebbe aggiornarsi automaticamente quando cambio l'anno e tali righe non dovrebbero comparire nei giorni di sabato e domenica. Potrei anche mandare a qualcuno il file qualora non fossi stati chiaro.

grazie

[Flash30005]

Ciao Nicolami e benvenuto nel Forum

Sei stato sufficientemente chiaro per quanto riguarda la tua esigenza ma per impostare una macro abbiamo bisogno di molti altri dettagli riguardanti i dati di input (dove si trovano le date, i giorni della settimana, dove vorresti inserire queste righe-orario etc)

pertanto invia il file con almeno due settimane complete (le prime due di gennaio).
Per complete intendo come vorresti fossero compilate.
Ti chiedo due settimane perché nei primi giorni di gennaio ci sono anche dei festivi che fanno eccezione e vorrei vedere come li imposti

ciao

[Flash30005]

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

[nicolami]

Ciao,
funziona tutto...ora potrò utilizzare il file excel in modo perpertuo....sempre se non fallisce l'azienda in cui lavoro
Qualora ci fosse qualcuno che necessita del file, potrò inviarlo. Si tratta di un foglio di lavoro in cui viene scandita la giornata lavorativa dalle 08:30 alle 17:30 scandendola di mezz'ora in mezz'ora per ogni giorno lavorativo escluso il week.end (vi è una pagina principale chiamata "totale anno" in cui sono riportati i risultati della documentazione ritirata negli altri 12 fogli), ed in ogni riga viene registrato il nome della ditta che consegna la documentazione segnalando di eventuali errore, correzioni. beh forse è più semplice a vedersi a a spiegarlo

beh un grazie di cuore a flash30005 per il grossissimo problema che mi ha risolto!!!