VBA Create Diagramms

[o0omax]

I want to create multiple diagrams outomatically. Does somebody know how to debug?


Sub MakroTest()

Dim MyWorksheet As Worksheet
Dim i As Integer
Dim DL As Long

Set MyWorksheet = ActiveSheet

DL = MyWorksheet.Cells(Rows.Count, 1).End(xlUp).Row


For i = 2 To DL 'end of the liste
'if only do it if i equals to this excel eqaution: =AND(ROW()>1;INDEX(A:A;ROW())=INDEX(A:A;ROW()-1))
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("A1:C1,A"&i"C"&i) 'i know that here is an error
ActiveChart.ApplyChartTemplate ( _
"C:\Users\[...]\Microsoft\Templates\Charts\InvestImpact Diagramm.crtx" _
)


Next

End Sub

[o0omax]

Thats the solution:


Sub DiagrammErstellen()

Dim DL As Integer '#Zeilen
Dim i As Integer ' Zeilen Laufindex

Dim sheet As Worksheet

Set MyWorksheet = ThisWorkbook.Sheets("KPI")
Application.CutCopyMode = False

DL = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To DL

If Cells(14, i) = FALSCH Then

With MyWorksheet.Shapes.AddChart2(216, xlBarClustered)


'--------Größe und Position------
.Width = 200
.Height = 50
.Top = Cells(i, 2).Top
.Left = Cells(i, 2).Left

'----------Layout--------------
.Fill.Visible = msoFalse
.Line.Visible = msoFalse

With .Chart
.ChartArea.ClearContents
.SeriesCollection.NewSeries

With .FullSeriesCollection(1)

.Name = "=Pivot! " & Cells(i, 1).Address
.Values = "=Pivot!" & Range(Cells(i, 2), Cells(i, 3)).Address
.XValues = "=Pivot!" & Range(Cells(1, 2), Cells(1, 3)).Address

End With

.SetElement (msoElementPrimaryValueGridLinesNone)
.SetElement (msoElementDataLabelOutSideEnd)
.ChartGroups(1).GapWidth = 0
.ChartTitle.Delete
.Axes(xlValue).Delete
.Axes(xlCategory).Delete

.PlotArea.Select
Selection.Left = 0


''---------Layout2-------- Balken 1 bei selection format line braucht man nicht alles
.FullSeriesCollection(1).Points(2).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(205, 219, 229)
.Transparency = 0
.Solid
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.RGB = RGB(0, 0, 0)
.ForeColor.Brightness = 0
End With

ActiveChart.FullSeriesCollection(1).Points(1).Select

With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(180, 202, 216)
.Transparency = 0
.Solid
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.RGB = RGB(0, 0, 0)
.ForeColor.Brightness = 0
.Transparency = 0

'.HasLegend = False
End With

End With

End With

End If
Next i

End Sub