Option Explicit
Const CHARTNAME As String = "Diagramm1"
Const XFORMULA As String = "='Kanal1'!A2:AZeile"
Const NFORMULA As String = "='Kanal1'!COL1"
Const VFORMULA As String = "='Kanal1'!COL2:COLROW"
Const VSPALTEN As String = "B,C,D,F,H"
Dim strAction As String, strlX As String
Sub TryThis()
Dim oChart As Chart
Dim strName As String
Dim strXValues As String
Dim i As Long
Dim lX As Long
Dim ArrCols() As String
For Each oChart In ThisWorkbook.Charts
Select Case MsgBox("vorhandenes Diagramm löschen?", _
vbYesNo Or vbQuestion Or vbDefaultButton1, oChart.Name)
Case vbYes
oChart.Delete
Case vbNo
End Select
Next oChart
strName = CHARTNAME
i = ThisWorkbook.Charts.Count
If i > 0 Then strName = Replace(strName, "1", Format(i + 1, "0"))
With Sheets("Kanal1")
lX = .Range("A1").End(xlDown).Row
If lX = .Rows.Count Or lX = 1 Then Exit Sub
End With
strlX = Format(lX, "0")
ArrCols = Split(VSPALTEN, ",")
ThisWorkbook.Charts.Add Before:=Worksheets("Kanal2")
With ActiveChart
.ChartType = xlLineMarkers
.Name = strName
For i = LBound(ArrCols) To UBound(ArrCols)
strAction = ArrCols(i)
NewSeriesCollection
Next i
.SeriesCollection(2).AxisGroup = 2
.SeriesCollection(5).AxisGroup = 2
.DisplayBlanksAs = xlInterpolated
.ClearToMatchStyle
.ChartStyle = 42
.Legend.Position = xlTop
End With
End Sub
Sub NewSeriesCollection()
Dim x As Long
With ActiveChart
.SeriesCollection.NewSeries
x = .SeriesCollection.Count
.SeriesCollection(x).Name = Replace(NFORMULA, "COL", strAction)
strAction = Replace(VFORMULA, "COL", strAction)
.SeriesCollection(x).Values = Replace(strAction, "ROW", strlX)
.SeriesCollection(x).XValues = Replace(XFORMULA, "Zeile", strlX)
End With
End Sub