Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim an%, mois%, h%, resu, source, i%, ii%, j%, x$
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
an = [B1]
mois = Month("1/" & [B2])
h = Day(Application.EoMonth(DateSerial(an, mois, 1), 0))
'---mises en forme---
[A5:J35].ClearContents
[A33:A35].Interior.ColorIndex = xlNone
[A33:J35].Borders.LineStyle = xlNone
If h > 28 Then [B33:J33].Resize(h - 28).Borders.Weight = xlThin
If Err = 0 Then [A5] = DateSerial(an, mois, 1)
[A5].AutoFill [A5].Resize(h) 'remplissage valeurs et formats
'---tableaux VBA, plus rapides---
resu = [B5:J5].Resize(h) 'tableau final non structuré
source = [Tab_DataSrc] 'tableau structuré
For i = 1 To UBound(source)
If source(i, 4) = an And source(i, 5) = mois Then
ii = source(i, 6): j = source(i, 7) - 7
x = resu(ii, j)
resu(ii, j) = IIf(x = "", "", x & vbLf) & source(i, 11) & " - " & source(i, 13)
End If
Next i
'---restitution et cadrage---
With [B5:J35]
.Resize(h) = resu
.ColumnWidth = 255
.Rows.AutoFit
.Columns.AutoFit
For i = 1 To .Columns.Count
If .Columns(i).ColumnWidth = 255 Then .Columns(i).ColumnWidth = 15
Next i
End With
Application.EnableEvents = True 'réactive les évènements
End Sub