Option Explicit
Public MoisActuel As String
Public AnnéeActuelle 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
Const sWd As String = "Heure"
Sub FeuilMoisActuel()
MoisActuel = Format(Date, "mmm yyyy")
AnnéeActuelle = Format(Date, "yyyy")
Application.ScreenUpdating = False
Dim i&
For i = 1 To Sheets.Count
If Sheets(i).Name = (MoisActuel) Then
Exit Sub
Else
If Sheets(i).Name = "Feuil" & i Then
Sheets(i).Tab.Color = 39423
'' Sheets(i).Name = MoisActuel
End If
If Sheets(Sheets.Count).Name <> MoisActuel Then
'' Sheets.Add After:=Sheets(Sheets.Count)
'' Sheets(Sheets.Count).Tab.Color = 39423
'' Sheets(Sheets.Count).Name = MoisActuel
'' Identité.Show
Exit For
End If
End If
Next i
Columns("A:A").ColumnWidth = 2
Columns("B:C").ColumnWidth = 4
Columns("D:F").ColumnWidth = 11
Columns("G:K").ColumnWidth = 8
Columns("L:L").ColumnWidth = 2
Rows("1:1").RowHeight = 12
Dim CheminLogo As String
' CheminLogo = "C:\Logos\" & "TEC.jpg"
' ActiveSheet.Shapes.AddPicture CheminLogo, True, True, 15, 1, 383, 57
' Identité.Show
Range("B1:K4,B5:K5,M2:N2,O2:P2,M3:N3,O3:P3,M4:N4,O4:P4,M5:N5,O5:P5,M6:N6,O6:P6").MergeCells = True
With Range("M2:N6")
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
With Range("O2:P6")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
Range("M2") = "Dépôt de "
Range("M3") = "Chauffeur "
Range("M4") = "Matricule "
Range("M5") = "Numéro National "
Range("M6") = "Embauché(e) le "
Range("O2") = Dépôt
Range("O3") = Prénom & " " & NOM
Range("O4") = Matricule
Range("O5") = National
Range("O6") = DateSelect
Dim Form$, IntV&, arrSTR ', i As Byte
arrSTR = Array("Date", "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("B1:K4,B5:K5,B6,C6,D6,E6,F6,G6,H6,I6,J6,K6")
.BorderAround 1, 4, -4105: .Interior.Color = 39423
.Font.Size = 10: .Font.Bold = True
.HorizontalAlignment = -4108: .VerticalAlignment = -4108
End With
Range("B5:K5").HorizontalAlignment = 7
Range("B5") = StrConv(Format(Date, "mmmm yyyy"), vbUpperCase)
For i = 0 To 9
Cells(6, Chr(66 + i)) = arrSTR(i)
Next i
IntV = CLng(Day(DateSerial(Year(Date), Month(Date) + 1, 0)))
Form = "DATE(YEAR(TODAY()),MONTH(TODAY()),ROW()-6)"
With Range("B7")
.Resize(33, 10).Clear
With .Resize(IntV, 1)
.Font.Size = 10: .Font.Bold = True
.HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
.FormulaR1C1 = "=TEXT(" & Form & ",""jj"")&MID(""DLMMJVS"",WEEKDAY(" & Form & "),1)"
.Value = .Value
With .Offset(, 1)
.Font.Size = 10: .Font.Bold = True
.HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
.Value = "CC"
End With
With .Resize(IntV, 10)
.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""S"""
.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""D"""
.FormatConditions(1).Interior.ThemeColor = 3
.FormatConditions(2).Interior.ThemeColor = 3
.FormatConditions(.FormatConditions.Count).SetFirstPriority
End With
With .Resize(IntV, 10)
.BorderAround 1, 4, -4105: .Borders(11).LineStyle = 1
.Borders(3).LineStyle = 1
End With
With Range(Cells(IntV + 7, 2), Cells(IntV + 7, 11))
.BorderAround 1, 4, -4105: .Borders(11).LineStyle = 1
.HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
.Font.Bold = True: .Font.Size = 10: .Interior.Color = 39423
End With
With Range(Cells(IntV + 7, 2), Cells(IntV + 7, 5))
.MergeCells = True
.Value = "TOTAUX"
End With
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)
' Range("B7:C37").ClearContents
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)
With Range("C" & i + 6)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("C" & i + 6) = "JF"
Range("B" & i + 6, "K" & i + 6).Interior.Color = vbRed
End Select
i = i + 1
Next Ddate
' Else
' For i = 1 To Sheets.Count
' If Sheets(i).Name = (MoisActuel) Then Exit Sub
' Next i
' Sheets.Add After:=Sheets(Sheets.Count)
' Sheets(Sheets.Count).Name = MoisActuel
' Sheets(MoisActuel).ScrollArea = "A1:Z120"
'End If
End Sub
