Private Sub Worksheet_Calculate()
Dim efface As Boolean, deb&, dat&, i&, a(1 To 118, 1 To 2) '118 = 2 x 53 semaines + 12
efface = Year(Date) <> Year(Val(CStr([Jour]))) 'test pour le début de l'année
Application.ScreenUpdating = False
[A3].Resize(UBound(a), 2).NumberFormat = "General" 'RAZ
deb = 3
For dat = DateSerial([A1], 1, 1) To DateSerial([A1], 12, 31)
If Weekday(dat) = 3 Then
i = i + 1
a(i, 1) = dat
If efface Then a(i, 2) = Empty Else a(i, 2) = Cells(i + 2, 2)
Cells(i + 2, 1).NumberFormat = """Mardi"" * dd/mm/yyyy" 'format Date personnalisé
ElseIf Weekday(dat) = 4 Then
i = i + 1
a(i, 1) = dat
If efface Then a(i, 2) = Empty Else a(i, 2) = Cells(i + 2, 2)
Cells(i + 2, 1).NumberFormat = """Mercredi"" * dd/mm/yyyy" 'format Date personnalisé
End If
If Month(dat) < Month(dat + 1) Then
i = i + 1 'saut de ligne
a(i, 1) = 0
a(i, 2) = "=SUM(B" & deb & ":B" & i + 1 & ")"
Cells(i + 2, 1).NumberFormat = """Total"""
deb = i + 3
End If
Next dat
'---dernier Total---
a(i + 1, 1) = 0
a(i + 1, 2) = "=SUM(B" & deb & ":B" & i + 2 & ")"
Cells(i + 3, 1).NumberFormat = """Total"""
'---restitution et MFC---
Application.EnableEvents = False 'désactive les évènements
With [A3].Resize(UBound(a))
.Resize(, 2) = a 'restitution
.Resize(, 2).FormatConditions.Delete 'RAZ
ThisWorkbook.Names.Add "Jour", Date 'nom défini
ThisWorkbook.Names.Add "Mini", "=MIN(ABS(" & .Address & "-Jour))" 'formule matricielle nommée
.FormatConditions.Add xlExpression, Formula1:="=ABS(A3-Jour)=Mini"
.FormatConditions(1).Interior.Color = vbRed
.FormatConditions(1).Font.Color = vbWhite
.FormatConditions(1).Font.Bold = True 'gras
.Resize(, 2).FormatConditions.Add xlExpression, Formula1:="=""""&$A3=""0"""
.Resize(, 2).FormatConditions(2).Interior.Color = vbCyan
.Resize(, 2).FormatConditions(2).Font.Bold = True 'gras
End With
Columns("A:B").AutoFit 'ajustement largeurs
Application.EnableEvents = True 'réactive les évènements
End Sub