Graphes dynamiques

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
Dim N As Name
Dim bool As Boolean
For Each N In ActiveWorkbook.Names
  If N.Name = MON_NOM Then
    bool = True
    Exit For
  End If
Next N
If Not bool Then Exit Sub
Set R = Application.Intersect(Target, _
  Range(ActiveWorkbook.Names("MaPlage").RefersTo))
If Not R Is Nothing Then Call UpdateGraph
End Sub

'### Constantes à adapter ###
Private Const MON_GRAPH As String = "Graphique 1"
Public Const MON_NOM As String = "MaPlage"
'############################
Sub UpdateGraph(Optional dummy As Byte)
Dim CH As Chart
Dim i&
Dim j&
Dim R As Range
Dim R2 As Range
Dim A$
On Error Resume Next
Set CH = ActiveSheet.ChartObjects(MON_GRAPH).Chart
If CH Is Nothing Then
  MsgBox "Impossible de trouver le graphique " & MON_GRAPH
  Exit Sub
End If
Set R = Range(ActiveWorkbook.Names(MON_NOM))
If R Is Nothing Then
  MsgBox "Impossible de trouver la plage de nom " & MON_NOM
  Exit Sub
End If
On Error GoTo Erreur
Set R = R.Offset(2, 1).Resize(R.Rows.Count - 2, R.Columns.Count - 1)
A$ = "=("
For j& = 1 To R.Columns.Count
  For i& = 1 To R.Rows.Count
    If R.Cells(i&, j&) <> "" Then
      If R2 Is Nothing Then
        Set R2 = R.Cells(i&, j&)
      Else
        Set R2 = Application.Union(R2, R.Cells(i&, j&))
      End If
    End If
  Next i&
  If Not R2 Is Nothing Then
    A$ = A$ & R2.Parent.Name & "!" & R2.Address(, , xlR1C1) & ","
    Set R2 = Nothing
  End If
Next j&
A$ = Mid(A$, 1, Len(A$) - 1) & ")"
CH.SeriesCollection(1).Values = A$
Exit Sub
Erreur:
MsgBox "Erreur : " & Err.Number & vbCrLf & _
  Err.Description
End Sub