AW: Y-Achsenskalierung mit Zellbezug
28.04.2014 14:39:38
Thomas
Vielleicht stehe ich auch einfach auf dem Schlauch, aber ich glaube das habe ich eigentlich gemacht. Vielleicht kannst du ja mit dem Code mehr anfangen, mit dem ich das Diagramm erstelle:
ActiveSheet.Shapes.AddChart.Select 'Diagramm hinzufügen
ActiveChart.ChartType = xlColumnStacked 'Diagrammtyp=Säulendiagramm
'Ermittlung der Anzahl an automatisch eingetragenen Datenreihen
intchartrow = ActiveChart.SeriesCollection.Count
' Löschen der Datenreihen beginnend mit der größten
For intcounter = intchartrow To 1 Step -1
ActiveChart.SeriesCollection(intcounter).Delete
Next intcounter
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Diagramm" 'Diagramm in neues Sheet, _
mit Namen "Diagramm"
ActiveSheet.Move After:=Worksheets(Worksheets.Count) 'Neues Sheet ans Ende anfügen
With ActiveChart
.SeriesCollection.NewSeries
.SeriesCollection(1).Values = Range(Sheets("Daten für Diagramm").Cells(2, 5), Sheets("Daten _
für Diagramm").Cells(Anzahlgesamt + 1, 5)) 'Daten Hilfe in Säulendiagramm als Datenreihe 1 eintragen
.SeriesCollection.NewSeries
.SeriesCollection(2).Values = Range(Sheets("Daten für Diagramm").Cells(2, 7), Sheets("Daten _
für Diagramm").Cells(Anzahlgesamt + 1, 7)) 'Daten Säulekorrektur in Säulendiagramm als Datenreihe 2 eintragen
.SeriesCollection(2).Format.Fill.Visible = msoFalse 'Säulen ohne Füllung, damit unsichtbar
.SeriesCollection.NewSeries
.SeriesCollection(3).Values = Range(Sheets("Daten für Diagramm").Cells(2, 4), Sheets("Daten _
für Diagramm").Cells(Anzahlgesamt + 1, 4)) 'Daten Masnahmekorrektur in Säulendiagramm als Datenreihe 3 eintragen
.SeriesCollection.NewSeries
.SeriesCollection(4).Values = Range(Sheets("Daten für Diagramm").Cells(2, 8), Sheets("Daten _
für Diagramm").Cells(Anzahlgesamt + 1, 8)) 'Daten Masnahmekorrektur in Säulendiagramm als Datenreihe 3 eintragen
.SeriesCollection(1).XValues = Range(Sheets("Daten für Diagramm").Cells(2, 1), Sheets(" _
Daten für Diagramm").Cells(Anzahlgesamt + 1, 1)) 'Beschriftung der x-Achse
.Legend.Delete 'Legendenbeschriftung löschen
.SetElement (msoElementChartTitleAboveChart)
.ChartTitle.Text = "Energiekaskade" 'Diagrammtitel = Energiekaskade
.SetElement (msoElementPrimaryValueAxisTitleRotated)
Selection.Caption = Diagrammeinheit 'Beschriftung y-Achse mit ausgewählter Einheit aus Userform _
Einheit
.SeriesCollection(3).Select
.ChartGroups(1).GapWidth = 40 'Abstand der Balken wählen
.Axes(xlCategory).TickLabelPosition = xlLow 'x-Achsenbeschriftung unter das Diagramm setzen
For i = 1 To Anzahlgesamt Step 1 'Datenbeschriftung über Schleife,
.SeriesCollection(3).ApplyDataLabels
If Not Sheets("Daten für Diagramm").Cells(i + 1, 4) = 0 Then
If Not IsEmpty(Sheets("Daten für Diagramm").Cells(i + 1, 4)) Then
ActiveChart.SeriesCollection(3).Points(i).DataLabel.Formula = "='Daten für Diagramm' _
!B" & i + 1
End If
End If
.SeriesCollection(3).DataLabels.NumberFormat = "#.##0,0"
Next
.Axes(xlValue).MinimumScale = Sheets("Daten für Diagramm").Cells(2, 14) 'Minimalwert der y- _
Achse
.Axes(xlValue).MaximumScale = Sheets("Daten für Diagramm").Cells(2, 13) 'Maximalwert der y- _
Achse
.Axes(xlValue).MinorUnitIsAuto = True
.Axes(xlValue).MajorUnitIsAuto = True
.Axes(xlValue).Select
.Axes(xlValue).MajorUnit = Sheets("Daten für Diagramm").Cells(2, 12) 'Hauptintervall der Y- _
Achsenbeschriftung
Exit sub