Nur befüllten Bereich beachten
20.10.2015 10:18:45
Raphi
mit eurer Hilfe war es mit bereits möglich ein gestapeltes Balkendiagramm aus meiner Datentabelle via VBA zu erstellen.
Nun ergibt sich für mich folgendes Problem:
Um kein gigantisches Diagramm zu erzeugen, welches fast leer ist, würde ich gerne nur befüllte Zellen in das Diagramm aufnehmen.
Leider fehlt mir hierzu die Kenntnis, da ich die verschiedenen SeriesCollection über VBA manuell hinzugefügt habe.
Zur besseren Verständnis habe ich einen Screenshot der Dateneingabe und einen Screenshot des Diagramms hinterlegt.
Hoffentlich kann mir jemand mit seiner Expertise helfen.
Beste Grüße aus Bayern,
Raphi
Sub Create_Gantt()
'Vorhandenes Diagramm löschen
With Sheets("P2_Gantt_Diagramm")
.ChartObjects("Gantt_Diagramm").Delete
End With
'Gantt Diagramm erstellen
Sheets("P2_Gantt_Diagramm").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlBarStacked
'Diagrammname
Worksheets("P2_Gantt_Diagramm").ChartObjects(1).Name = "Gantt_Diagramm"
'Datenrange anwählen
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).Values = "=P2_Gantt_Daten!$E$14:$E$95"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Values = "=P2_Gantt_Daten!$G$14:$G$95"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Values = "=P2_Gantt_Daten!$H$14:$H$95"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(4).Values = "=P2_Gantt_Daten!$E$14:$E$95"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(5).Values = "=P2_Gantt_Daten!$G$14:$G$95"
'Reihenfolge y-Achse umkehren
ActiveSheet.ChartObjects("Gantt_Diagramm").Activate
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).ReversePlotOrder = True
ActiveChart.SeriesCollection(5).XValues = "=P2_Gantt_Daten!$B$14:$B$95"
'Balken ausblenden(Datenreihe 1 und Datenreihe 5)
ActiveChart.SeriesCollection(1).Select
Selection.Format.Fill.Visible = msoFalse
Selection.Format.Line.Visible = msoFalse
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(4).Select
Selection.Format.Fill.Visible = msoFalse
Selection.Format.Line.Visible = msoFalse
ActiveChart.PlotArea.Select
'Format x-Achse (Datum) festlegen
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "dd.mm.yyyy"
Selection.TickLabels.NumberFormat = "dd.mm.yyyy;@"
ActiveChart.Axes(xlValue).MinimumScale = Worksheets("P2_Gantt_Daten").Cells(10, 3).Value
ActiveChart.Axes(xlValue).MaximumScale = Worksheets("P2_Gantt_Daten").Cells(10, 4).Value
'Y-Achse auf Teilstriche anordnen
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).AxisBetweenCategories = False
'Haupt- und Teilintervalle
ActiveChart.Axes(xlValue).MajorUnit = 7
ActiveChart.Axes(xlValue).MinorUnit = 1
ActiveChart.Axes(xlValue).TickLabels.Orientation = xlUpward 'Text um 270 Grad gedreht
'Legende ausblenden
ActiveChart.Legend.Select
ActiveChart.SetElement (msoElementLegendNone)
'Hauptgitter und Hilfsgitter
With ActiveSheet.ChartObjects("Gantt_Diagramm").Activate
ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementPrimaryValueGridLinesMinorMajor)
ActiveChart.Axes(xlValue).MinorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.Weight = 0.25
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0.5
.ForeColor.Brightness = 0
.Transparency = 0.6599999964
End With
End With
'Größe Gesamtes Diagramm festlegen
Dim wks As Worksheet
Dim wksShape As Shape
With wksShape
ActiveSheet.ChartObjects("Gantt_Diagramm").Width = 2000
ActiveSheet.ChartObjects("Gantt_Diagramm").Height = 1300
End With
'Größe Plottbereich
ActiveChart.PlotArea.Select
Selection.Width = 2000
Selection.Height = 1200
Selection.Left = 130
Selection.Top = 50
'Diagramm ausrichten
ActiveSheet.ChartObjects("Gantt_Diagramm").Top = Range("B5").Top
ActiveSheet.ChartObjects("Gantt_Diagramm").Left = Range("B5").Left
End Sub
