Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Target.Worksheet.Columns(2)
If Not Intersect(Target, rng) Is Nothing Then
Call Diagramm_aktualisieren
End If
End Sub
Private Sub Diagramm_aktualisieren()
Dim objChart As Chart
Dim serItem As Series, serCheck As Series
Dim rng As Range
Dim bExists As Boolean
Set objChart = Me.ChartObjects(1).Chart
For Each serItem In objChart.SeriesCollection
serItem.Delete
Next
For Each rng In Intersect(Me.UsedRange, Me.Columns(2)).Cells
If ExistsWorksheet(rng.Value) Then
bExists = False
For Each serCheck In objChart.SeriesCollection
If serCheck.Name = rng.Value Then
bExists = True
Exit For
End If
Next
If Not bExists Then
Set serItem = objChart.SeriesCollection.NewSeries
Debug.Print rng.Value
serItem.Name = "=""" & rng.Value & """"
serItem.XValues = "='" & rng.Value & "'!$B$2:$C$6"
serItem.Values = "='" & rng.Value & "'!$C$2:$C$6"
End If
End If
Next
End Sub
Private Function ExistsWorksheet(SearchName As String) As Boolean
Dim wsh As Worksheet
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Name = SearchName Then
ExistsWorksheet = True
Exit For
End If
Next
End Function