Option Explicit
Private Sub Worksheet_Activate()
Dim Dico As Dictionary, Données As Collection, NbEmpl As Long, CMax As Long, LMax As Long, _
TTit(), TRés(), Réf As SsGr, Emp As SsGr, L As Long, SCn As SeriesCollection, _
LOt As ListObject, Rng As Range, C As Long, AdrEmpl As String, S As Series
Rem. ——— Élaboration des tableaux dynamiques à verser comme résultats.
Set Dico = DicInvent(Feuil1, 8, 2): NbEmpl = Dico.Count: CMax = NbEmpl + 1
Set Données = Gigogne(Null, 2, 8): LMax = Données.Count
ReDim TTit(1 To 1, 1 To CMax), TRés(1 To LMax, 1 To CMax)
TTit(1, 1) = "Référence": VerserEntêtes TTit, Dico
For Each Réf In Gigogne(Feuil1, 2, 8)
L = L + 1
TRés(L, 1) = Réf.ID
For Each Emp In Réf.Co
If Dico.Exists(Emp.ID) Then TRés(L, Dico(Emp.ID)) = Emp.Count
Next Emp, Réf
Rem. ——— Suppression des séries, lignes et colonnes en trop.
Set SCn = ChartObjects(1).Chart.SeriesCollection
While LMax < SCn.Count: SCn(LMax + 1).Delete: Wend
Set LOt = Me.ListObjects(1)
While LOt.ListRows.Count > LMax: LOt.ListRows(LMax + 1).Delete: Wend
While LOt.ListColumns.Count > CMax: LOt.ListColumns(CMax + 1).Delete: Wend
Rem. ——— Versement des résultats.
LOt.HeaderRowRange.Resize(, CMax).Value = TTit
LOt.DataBodyRange.Resize(LMax, CMax).Value = TRés
Rem. ——— Correction des séries.
Set Rng = LOt.HeaderRowRange
For C = 2 To CMax: Dico(TRés(1, C)) = C: Next C
NbEmpl = Rng.Columns.Count - 1
AdrEmpl = Rng(1, 2).Resize(, NbEmpl).Address(True, True, xlA1, True)
For L = 1 To UBound(TRés, 1)
Set Rng = LOt.ListRows(L).Range
If L <= SCn.Count Then Set S = SCn(L) Else Set S = SCn.Add(Rng(1, 1))
S.Formula = "=SERIES(""" & TRés(L, 1) & """," & AdrEmpl & "," _
& Rng(1, 2).Resize(, NbEmpl).Address(True, True, xlA1, True) & "," & L & ")"
Next L
End Sub
