Sekundärachse Punktdiagramm
08.06.2016 19:57:02
Anton
ich versuche mich gerade mit einer For Schleife durch jedes Sheet zu arbeiten und dabei aus drei Datenreihen ein Punktdiagramm zu erstellen. Die dritte Datenreihe soll als Sekundärachse hinzugefügt werden. Folgenden Ansatz habe ich:
Sub DiagrammMitSekundaerachse ()
Dim wks As Worksheet
Dim lngZeileMax as Integer
Dim Dia As ChartObject
Dim rng As Range
For Each wks In ThisWorkbook.Sheets
With wks
If .Name "UserForm" Then
lngZeileMax = .Range("C21").End(xlDown).Row - 1
For Each rng In .Range("C21:C" & lngZeileMax).Cells
If WorksheetFunction.IsText(rng) Then
rng.Value = Left(rng.Value, Len(rng.Value) - 2) * 1
End If
Next rng
.Range("D20").Value = "Umsatz2"
.Range("A20").Value = 0
.Range("C21:C" & lngZeileMax).Cells.Copy .Range("D21:D" & lngZeileMax).Cells
On Error Resume Next
Set Dia = .ChartObjects.Add(300, 300, 500, 300)
Dia.Name = ActiveSheet.Name
i = .Range("D20").End(xlDown).Row - 1
.Range("A20:D" & i).Copy
.ChartObjects(Dia.Name).Activate
ActiveChart.SeriesCollection.Paste _
Rowcol:=xlColumns, SeriesLabels:=False, _
CategoryLabels:=True, Replace:=True, NewSeries:=True
Application.CutCopyMode = False
With ActiveChart.SeriesCollection(3)
.XValues = wks.Range(wks.Cells(A21, 1), wks.Cells(lngZeileMax, 1))
.Values = wks.Range(wks.Cells(D21, 4), wks.Cells(lngZeileMax, 4))
.AxisGroup = xlSecondary
End With
With ActiveChart
.ChartType = xlLineMarkers
.HasLegend = True
.HasTitle = True
.ChartTitle.Text = Dia.Name
End With
End If
End With
Next wks
End Sub
Danke für eure Hilfe.
VG Anton