Tableau horaire

Le 04/07/2014 à 01:52

Bonjour à tous,

J'ai crée un tableau afin de noter mes heures de travail.

Hors périodes de congés scolaires, les lignes correspondant aux mercredis sont surlignées en vert, les lignes pour les samedis en bleu et les lignes pour les dimanches en jaune.

Mais en périodes de congés scolaires, je souhaiterai que les lignes du lundi au vendredi soient surlignées en rose tout en laissant les samedi en bleu et les dimanches en jaune.

Les dates de congés scolaires en 2014-2015 sont les suivantes:

  • Eté : du 1 juillet au 31 août 2014
  • Toussait : du 27 octobre au 31 octobre 2014
  • Hiver : du 22 décembre 2014 au 2 janvier 2015
  • Printemps : du 6 avril au 17 avril 2015

Voici ci-dessous le code ne prenant pas en compte les dites congés scolaires...

Option Explicit

Public MoisActuel As String
Public AnnéeActuelle As String
Public VacEté As String

Public Dépôt As String, NOM As String, Prénom As String, Matricule As String, National As String
Public DateSelect As String
Public IntV As Long
Const sWd As String = "Heure"
Public j As Integer

Sub FeuilNouveauMois()
MoisActuel = Format(Date, "mmm yyyy")
AnnéeActuelle = Format(Date, "yyyy")

Application.ScreenUpdating = False
'If Sheets(Sheets.Count).Name <> MoisActuel Then
'    Sheets.Add After:=Sheets(Sheets.Count)
'    Sheets(Sheets.Count).Name = MoisActuel
'    Sheets(MoisActuel).Tab.Color = 39423
'    CreationTableau
'End If
End Sub

Sub CreationTableau()

MoisActuel = Format(Date, "mmm yyyy")
VacEté = Format(Date, "mmmm")
If VacEté = "juillet" Or VacEté = "août" Then VacEté = 1
Rows("1:1").RowHeight = 12
Columns("A:A").ColumnWidth = 2
Columns("B:B").ColumnWidth = 4
Columns("C:C").ColumnWidth = 4
Columns("D:D").ColumnWidth = 6
Columns("E:E").ColumnWidth = 11
Columns("F:F").ColumnWidth = 4
Columns("I:T").ColumnWidth = 6
Columns("U:U").ColumnWidth = 2

'Columns("C:C").ColumnWidth = 6
'Columns("D:D").ColumnWidth = 16
'Columns("E:E").ColumnWidth = 4
'Columns("F:G").ColumnWidth = 11
'Columns("H:S").ColumnWidth = 6
'Columns("T:T").ColumnWidth = 2

Dim CheminLogo As String
CheminLogo = "C:\" & "TEC Hainaut.jpg"
'ActiveSheet.Shapes.AddPicture CheminLogo, True, True, 16, 13, 716, 45
Range("B2:T4,B5:T5,I6:J6,K6:L6,M6:N6,O6:P6,Q6:R6,S6:T6,V2:W2,X2:Y2,V3:W3,X3:Y3,V4:W4,X4:Y4,V5:W5,X5:Y5,V6:W6,X6:Y6").MergeCells = True
With Range("T2:W6")
    .HorizontalAlignment = xlRight
    .Offset(, 2).HorizontalAlignment = xlLeft
    With .Resize(, 4)
        .VerticalAlignment = xlCenter
        .Font.Bold = True
    End With
End With
If Sheets.Count = 1 Then
'    Identité.Show
    Range("V2") = "Dépôt de "
    Range("V3") = "Chauffeur "
    Range("V4") = "Matricule "
    Range("V5") = "Numéro National "
    Range("V6") = "Embauché(e) le "
    Range("X2") = Dépôt
    Range("X3") = Prénom & " " & NOM
    Range("X4") = Matricule
    Range("X5") = National
    Range("X6") = DateSelect
Else
    Range("V2") = Sheets(1).Range("U2")
    Range("V3") = Sheets(1).Range("U3")
    Range("V4") = Sheets(1).Range("U4")
    Range("V5") = Sheets(1).Range("U5")
    Range("V6") = Sheets(1).Range("U6")
    Range("X2") = Sheets(1).Range("W2")
    Range("X3") = Sheets(1).Range("W3")
    Range("X4") = Sheets(1).Range("W4")
    Range("X5") = Sheets(1).Range("W5")
    Range("X6") = Sheets(1).Range("W6")
End If

Dim Form$, i&, arrSTR
arrSTR = Array("Date", "Jour", "Service", "Ligne", "Type", sWd & " Début" & Chr(10) & "de Service", sWd & " Fin" _
& Chr(10) & "de Service", "Nb " & sWd & "s" & Chr(10) & "Travaillées", sWd & "s" & Chr(10) & "de jour", _
sWd & "s" & Chr(10) & "de nuit", sWd & "s" & Chr(10) & "à 150%", sWd & "s" & Chr(10) & "à 200%", sWd & "s" _
& Chr(10) & "Sam/Dim")
With Range("B2:T4,B5:T5,B6,C6,D6,E6,F6,G6,H6,I6,J6,K6,L6,M6,N6,O6,P6,Q6,R6,S6,T6")
    .BorderAround 1, 4, -4105: .Interior.Color = 39423
    .Font.Size = 10: .Font.Bold = True
    .HorizontalAlignment = -4108: .VerticalAlignment = -4108
End With

Range("B5:M5").HorizontalAlignment = xlCenter
Range("B5") = StrConv(Format(Date, "mmmm yyyy"), vbUpperCase)

For i = 0 To 6
Cells(6, Chr(66 + i)) = arrSTR(i)
Next i

j = 0
For i = 7 To 12
Cells(6, Chr(66 + i + j)) = arrSTR(i)
j = j + 1
Next i

IntV = CLng(Day(DateSerial(Year(Date), Month(Date) + 1, 0)))
'Form = "DATE(YEAR(TODAY()),MONTH(TODAY()),WEEK(TODAY()),ROW()-6)"
Form = "DATE(YEAR(TODAY()),MONTH(TODAY()),ROW()-6)"

With Range("B7")
    .Resize(IntV + 1, 12).Clear
    With .Resize(IntV + 1, 19)
        .Font.Size = 10
        .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
        .BorderAround 1, 4, -4105: .Borders(11).LineStyle = 1: .Borders(3).LineStyle = 1
        With Range(Cells(IntV + 7, 2), Cells(IntV + 7, 8))
            .MergeCells = True
            .Value = "TOTAUX"
        End With
        With Range(Cells(IntV + 7, 2), Cells(IntV + 7, 20))
            .BorderAround 1, 4, -4105: .Borders(11).LineStyle = 1
            .Font.Bold = True: .Interior.Color = RGB(255, 130, 0) '39423
        End With
    End With
    With .Resize(IntV, 1)
        .Font.Bold = True
'        .FormulaR1C1 = "=TEXT(" & Form & ",""jj"" & "" "")"
'        .FormulaR1C1 = "=TEXT(" & Form & ",""jj"" & "" "") & MID(""Di"",WEEKDAY(" & Form & "),2)"
'        .FormulaR1C1 = "=TEXT(" & Form & ",""jj"" & "" "") & MID(""Lu "",WEEKDAY(" & Form & "),2)"
        .FormulaR1C1 = "=TEXT(" & Form & ",""jj"")" ' & MID(""DLaMeJeVeSa "",WEEKDAY(" & Form & "),2)"
'             .FormulaR1C1 = "=INDEX({""Di"";""Lu"";""Ma"";""Me"";""Je"";""Ve"";""Sa""},WEEKDAY(" & Form & "))"
'        .FormulaR1C1 = "=TEXT(" & Form & ",""jj" & " " & "jjj"")"

'        .FormulaR1C1 = "=TEXT(" & Form & ",""jj"")"

'       .FormulaR1C1 = MID(""DLMMJVS"",WEEKDAY(" & Form & "),1)"
        .Value = .Value
        With .Offset(, 1)
            .Font.Bold = True
            .FormulaR1C1 = "=INDEX({""D"";""L"";""Ma"";""Me"";""J"";""V"";""S""},WEEKDAY(" & Form & "))"

            'With .Offset(, 8)
                '.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""L"""
                '.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""M"""
                '.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""J"""
                '.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""V"""
                '.FormatConditions(1).Interior.ThemeColor = 2
                '.FormatConditions(2).Interior.ThemeColor = 2
                '.FormatConditions(3).Interior.ThemeColor = 2
                '.FormatConditions(4).Interior.ThemeColor = 2
                '.FormatConditions(.FormatConditions.Count).SetFirstPriority
            'End With
        End With
    End With
    With .Resize(IntV, 19)
'If VacEté = 1 Then
'        .Interior.ColorIndex = 38 ' Rose
'        .FormatConditions.Add Type:=2, Formula1:="=Gauche($C7)=""S"""
'        .FormatConditions.Add Type:=2, Formula1:="=Gauche($C7)=""D"""
'        .FormatConditions(1).Interior.ColorIndex = 37 ' Bleu
'        .FormatConditions(2).Interior.ColorIndex = 36 ' Jaune
'        .FormatConditions(.FormatConditions.Count).SetFirstPriority
'
'Else
        .FormatConditions.Add Type:=2, Formula1:="=Gauche($C7)=""S"""
        .FormatConditions.Add Type:=2, Formula1:="=Gauche($C7)=""D"""
        .FormatConditions.Add Type:=2, Formula1:="=Droite($C7)=""e"""
        .FormatConditions(1).Interior.ColorIndex = 37 ' Bleu
        .FormatConditions(2).Interior.ColorIndex = 36 ' Jaune
        .FormatConditions(3).Interior.ColorIndex = 35 ' Vert
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
'End If
    End With
End With

Dim Ddate As Long, Ddebut As Long, Dfin As Long, PAQ As Long
Dim An As Integer, Dstat As String, Dcolor As Long
An = Year(Date)
PAQ = Evaluate("=DATE(" & An & ",3,29.56+0.979*MOD(204-11*MOD(" & An & ",19),30)- WEEKDAY(DATE(" & An & ",3,28.56+0.979*MOD(204-11*MOD(" & An & ",19),30))))")
Ddebut = DateSerial(An, Month(Date), 1)
Dfin = DateSerial(An, Month(Date) + 1, 0)
i = 1
For Ddate = Ddebut To Dfin
Select Case Ddate
    Case DateSerial(An, 1, 1) _
            , DateSerial(An, 5, 1) _
            , DateSerial(An, 7, 21) _
            , DateSerial(An, 8, 15) _
            , DateSerial(An, 11, 1) _
            , DateSerial(An, 11, 11) _
            , DateSerial(An, 12, 25) _
            , (PAQ + 1) _
            , (PAQ + 39) _
            , (PAQ + 50)
    Range("F" & i + 6) = "JF"
    With Range("B" & i + 6, "T" & i + 6)
    .Font.Bold = True
    .Font.Color = vbRed
    End With
'    Range("B" & i + 6, "S" & i + 6).Interior.Color = vbRed
End Select
i = i + 1
Next Ddate

    Range("G" & 7, "G" & IntV + 7).NumberFormat = "hh:mm"
    Range("G" & IntV + 7, "G" & IntV + 7).NumberFormat = "[hh]:mm"

    Range("H" & 7, "H" & IntV + 7).NumberFormat = "hh:mm"
    Range("H" & IntV + 7, "H" & IntV + 7).NumberFormat = "[hh]:mm"

    Range("I" & 7, "I" & IntV + 7).NumberFormat = "0.00"
'    Range("I" & IntV + 7, "I" & IntV + 7).NumberFormat = "0.00"

    Range("J" & 7, "J" & IntV + 7).NumberFormat = "hh:mm"
    Range("J" & IntV + 7, "J" & IntV + 7).NumberFormat = "[hh]:mm"

    Range("K" & 7, "K" & IntV + 7).NumberFormat = "0.00"
'    Range("K" & IntV + 7, "K" & IntV + 7).NumberFormat = "0.00"

    Range("L" & 7, "L" & IntV + 7).NumberFormat = "hh:mm"
    Range("L" & IntV + 7, "L" & IntV + 7).NumberFormat = "[hh]:mm"

    Range("M" & 7, "M" & IntV + 7).NumberFormat = "0.00"
'    Range("M" & IntV + 7, "M" & IntV + 7).NumberFormat = "0.00"

    Range("N" & 7, "N" & IntV + 7).NumberFormat = "hh:mm"
    Range("N" & IntV + 7, "N" & IntV + 7).NumberFormat = "[hh]:mm"

    Range("O" & 7, "O" & IntV + 7).NumberFormat = "0.00"
'    Range("O" & IntV + 7, "O" & IntV + 7).NumberFormat = "0.00"

    Range("P" & 7, "P" & IntV + 7).NumberFormat = "hh:mm"
    Range("P" & IntV + 7, "P" & IntV + 7).NumberFormat = "[hh]:mm"

    Range("Q" & 7, "Q" & IntV + 7).NumberFormat = "0.00"
'    Range("Q" & IntV + 7, "Q" & IntV + 7).NumberFormat = "0.00"

    Range("R" & 7, "R" & IntV + 7).NumberFormat = "hh:mm"
    Range("R" & IntV + 7, "R" & IntV + 7).NumberFormat = "[hh]:mm"

    Range("S" & 7, "S" & IntV + 7).NumberFormat = "0.00"
'    Range("S" & IntV + 7, "S" & IntV + 7).NumberFormat = "0.00"

    Range("T" & 7, "T" & IntV + 7).NumberFormat = "hh:mm"
    Range("T" & IntV + 7, "T" & IntV + 7).NumberFormat = "[hh]:mm"

    Range("H" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("I" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("J" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("K" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("L" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("M" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("N" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("O" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("P" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("Q" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("R" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("S" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("T" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"

'Ajout_Boutons
'Sheets(MoisActuel).ScrollArea = "A1:Z40"
Application.ScreenUpdating = True
End Sub

Merci pour votre aide

Le 04/07/2014 à 18:16

Bonsoir

peut-être revoir l'approche en utilisant les mises en forme conditionnelles, sans macro ;

saisir les dates de congés scolaires, et

- créer une formule testant si la date courante est dans une période de congés ou non

Mettre en forme conditionnellement dans l'ordre suivant, puisque la mise en forme suit la première condition vraie rencontrée :

  • si la date est hors congés scolaires, ET (un samedi ou un dimanche), couleur bleue
  • si la date courante est dans les congés scolaires, couleur rose
  • si la date est hors congés scolaires, ET un mercredi, couleur verte

ça permet de mettre à jour le tableau exercice après exercice en mettant à jour les dates de congés

manque le dimanche en jaune ; est-ce vraiment important de différencier samedi et dimanche ?

Rechercher des sujets similaires à "tableau horaire"