Array als NewCollection einlesen, klappt nicht
27.09.2018 16:29:06
David
ich möchte ein Array an ein Diagramm übergeben, allerdings bekomme ich am Ende beim Dateien einlesen immer die Meldung ungültiger Parametern, woran liegt das? In anderen Beispielen(Threads) bei denen genau so vorgegangen wurde, hat es so auch geklappt. Vielleicht findet ja jemand meinen Denkfehler, ich wäre sehr dankbar dafür.
Option Explicit
Sub draw_new_myversion()
' Variablen Deklaration
Dim checkend, activesheetname As String
Dim table_counter, selection_counter, k As Integer
Dim cht1 As Chart
Dim label As String
Dim sum(), delta() As Double
Dim name_point(), typ() As Variant
label = ThisWorkbook.Sheets("Efficiency_Waterfall_Chart").Cells(5, 5).Value
' Name vom ActiveSheet
'activesheetname = "ThisWorkbook.Sheets(" & """" & "Efficiency_Waterfall_Chart" & """" & ")"
' Feststellen welche Zeilen berücksichtig werden sollen bzw. welche nicht ("keine" und Leer)
table_counter = 9
selection_counter = 1
Do Until StrComp(checkend, "Ende", vbTextCompare) = 0
If ThisWorkbook.Sheets("Efficiency_Waterfall_Chart").Cells(table_counter, 2).Value = "" Or _
ThisWorkbook.Sheets("Efficiency_Waterfall_Chart").Cells(table_counter, 2).Value = "keine" Then
Else
ReDim Preserve sum(1 To selection_counter)
ReDim Preserve delta(1 To selection_counter)
ReDim Preserve name_point(1 To selection_counter)
ReDim Preserve typ(1 To selection_counter)
sum(selection_counter) = ThisWorkbook.Sheets("Efficiency_Waterfall_Chart").Cells( _
table_counter, 4).Value
delta(selection_counter) = ThisWorkbook.Sheets("Efficiency_Waterfall_Chart").Cells( _
table_counter, 3).Value
name_point(selection_counter) = ThisWorkbook.Sheets("Efficiency_Waterfall_Chart").Cells( _
table_counter, 1).Value
typ(selection_counter) = ThisWorkbook.Sheets("Efficiency_Waterfall_Chart").Cells( _
table_counter, 2).Value
selection_counter = selection_counter + 1
End If
table_counter = table_counter + 1
checkend = ThisWorkbook.Sheets("Efficiency_Waterfall_Chart").Cells(table_counter, 1).Value
Loop
'Diagramm erstellen und alte Loschen
ActiveSheet.ChartObjects("Effi").Delete
Set cht1 = ThisWorkbook.Sheets("Efficiency_Waterfall_Chart").ChartObjects.Add(852, 117, 970, _
_
550).Chart
'Diagrammtyp und Namenwahl
With cht1
.ChartType = xlColumnStacked 'xlColumnClustered
.Parent.name = "Effi"
.HasLegend = False
' X ACHSE
.HasAxis(xlCategory, xlPrimary) = True
.Axes(xlCategory, xlPrimary).TickLabels.Font.Size = 13
.Axes(xlCategory, xlPrimary).TickLabels.Font.name = "Arial"
.Axes(xlCategory, xlPrimary).TickLabels.Orientation = xlTickLabelOrientationUpward
' Y ACHSE
.HasAxis(xlValue, xlPrimary) = True
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = label
.Axes(xlValue, xlPrimary).AxisTitle.Font.Size = 14.25
.Axes(xlValue, xlPrimary).AxisTitle.Font.name = "Arial"
.Axes(xlValue, xlPrimary).TickLabels.Font.Size = 14.25
.Axes(xlValue, xlPrimary).TickLabels.Font.name = "Arial"
.Axes(xlValue, xlPrimary).TickLabels.NumberFormat = "0.0%"
End With
'Daten einlesen
cht1.SeriesCollection(1).Values = sum
cht1.SeriesCollection(1).XValues = name_point
cht1.SeriesCollection.NewSeries
cht1.SeriesCollection(2).Values = delta
End Sub