Private Sub Worksheet_Calculate()
Dim efface As Boolean, deb&, dat&, i&, a(1 To 120, 1 To 2) '120 = 2 x 53 semaines + 12 + 2
efface = Val(CStr([A1])) <> Val(CStr([Annee])) 'test pour le début de l'année
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
ThisWorkbook.Names.Add "Annee", Val([A1])
deb = 1
With [A3].Resize(UBound(a)) '1ère ligne à adapter au besoin
.Resize(, 1 - efface).ClearContents 'RAZ
For dat = DateSerial([Annee], 1, 1) To DateSerial([Annee], 12, 31)
If Weekday(dat) = 3 Then
i = i + 1
a(i, 1) = dat
If Not efface Then a(i, 2) = .Cells(i, 2)
.Cells(i).NumberFormat = """Mardi"" * dd/mm/yyyy" 'format Date personnalisé
ElseIf Weekday(dat) = 4 Then
i = i + 1
a(i, 1) = dat
If Not efface Then a(i, 2) = .Cells(i, 2)
.Cells(i).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(" & .Cells(deb, 2).Resize(i - deb).Address(0, 0) & ")"
.Cells(i).NumberFormat = """Total"""
deb = i + 1
End If
Next dat
'---dernier Total et Total année---
a(i + 1, 1) = 0
a(i + 1, 2) = "=SUM(" & .Cells(deb, 2).Resize(i + 1 - deb).Address(0, 0) & ")"
a(i + 3, 1) = 0
a(i + 3, 2) = "=SUM(" & .Cells(1, 2).Resize(i + 1).Address(0, 0) & ")/2"
.Cells(i + 1, 1).NumberFormat = """Total"""
.Cells(i + 3, 1).NumberFormat = """Total année"""
'---restitution et MFC---
.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