Option Explicit
Public MoisActuel As String
Public AnnéeActuelle 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")
Columns("A:A").ColumnWidth = 2
Columns("B:B").ColumnWidth = 6 '4
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
Rows("1:1").RowHeight = 12
Dim CheminLogo As String
Range("B2:S4,B5:S5,H6:I6,J6:K6,L6:M6,N6:O6,P6:Q6,R6:S6,U2:V2,W2:X2,U3:V3,W3:X3,U4:V4,W4:X4,_
U5:V5,W5:X5,U6:V6,W6:X6").MergeCells = True
With Range("T2:W6")
.HorizontalAlignment = xlRight
.Offset(, 2).HorizontalAlignment = xlLeft
With .Resize(, 4)
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
End With
Dim Form$, i&, arrSTR
arrSTR = Array("Date", "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:S4,B5:S5,B6,C6,D6,E6,F6,G6,H6,I6,J6,K6,L6,M6,N6,O6,P6,Q6,R6,S6")
.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 = 1
For i = 7 To 11
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()),ROW()-6)"
With Range("B7")
.Resize(IntV + 1, 12).Clear
With .Resize(IntV + 1, 18)
.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, 7))
.MergeCells = True
.Value = "TOTAUX"
End With
With Range(Cells(IntV + 7, 2), Cells(IntV + 7, 19))
.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"" & "" "") & MID(""DLMMJVS"",WEEKDAY(" & Form & "),1)"
.Value = .Value
With .Offset(, 1)
.Font.Bold = True
'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, 18)
.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""S"""
.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""D"""
.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""M""" ', Formula2:="=Droite($B7)=""J"""
.FormatConditions(1).Interior.ColorIndex = 37
.FormatConditions(2).Interior.ColorIndex = 36
.FormatConditions(3).Interior.ColorIndex = 35
.FormatConditions(.FormatConditions.Count).SetFirstPriority
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("E" & i + 6) = "JF"
With Range("B" & i + 6, "S" & 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("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("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)"
'Sheets(MoisActuel).ScrollArea = "A1:Z40"
Application.ScreenUpdating = True
End Sub