Hi,
ich habe eine Tabelle, die in Row 1 ab Spalte F, 26 Überschriften enthält.
in row 17 sind Werte, die ab Spalte F bis AE (26) enthalten sind.
Markiere ich F1-AE1 und danach mit STRG F17-AE17 und gehe auf Einfügen, Diagramme etc. bekomme ich beim ersten Anlauf ein perfektes Balkendiagramm, das auf der X-Achse alle 26 Überschriften aus F1-AE1 enthält und die Werte F17-AE17 als je einen Balken.
Versuche ich das zu automatisieren, klappt es nicht, denn die X Achse enthält nur eine 1 statt den Überschriften aus F1-AE1. Hier mein Code. Ich bedanke mich für alle Beiträge, die weiterhelfen.
ich gehe in das Blatt "Datenbasis" und suche eine Position aus Spalte E aus. Von dort aus wird der Code ausgelöst.Ich erkläre zuerst 2 ranges. Wertebereich und Überschriftenleiste und vereine diese zu diagrammbereich.
Sub Diagrammerstellen()
Sheets("Datenbasis").Activate
Dim i As Integer
Dim eingebettetesdiagramm As Shape
Dim rng As Range
Dim diagrammbereich As Range, wertebereich As Range
Dim bezeichnung As Range
Set bezeichnung = Selection
If Selection.Rows.Count > 1 Or Selection.Columns.Count > 1 Then
MsgBox ("Bitte wählen Sie nur eine Position in Spalte E aus"), vbOKOnly + vbCritical, "Warnung"
Exit Sub
End If
' ActiveChart.SetSourceData Source:=Range( _
' "Datenbasis!$F$17:$AE$17,Datenbasis!$F$1:$AE$1")
Dim zeile As Integer
zeile = ActiveCell.Row '.Count
'Set wertebereich = Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 26))
Set wertebereich = Range("Datenbasis!F" & zeile & ":AE" & zeile)
wertebereich.Select
Dim überschriftenleiste As Range
Set überschriftenleiste = Range("Datenbasis!$F$1:$AE$1")
überschriftenleiste.Select
Set diagrammbereich = Union(überschriftenleiste, wertebereich)
diagrammbereich.Select
Dim jahrrng As Range
Dim werterng As Range
'Bereinigen
Dim zelle As Range
For Each zelle In diagrammbereich
If zelle.Value = "leer" Or zelle.Value = "fehlende Angabe" Or zelle.Value = "0,001" Then
zelle.Value = ""
End If
Next
Sheets("Visualisierung").Activate
Set rng = Range("a2:e32")
'Cells(1, 1).Value = bezeichnung
Set eingebettetesdiagramm = Sheets("Visualisierung").Shapes.AddChart2(201, xlColumnClustered, Left:=rng.Left, Width:=rng.Width, Top:=rng.Top, Height:=rng.Height)
eingebettetesdiagramm.Chart.SetSourceData Source:=diagrammbereich
eingebettetesdiagramm.Chart.ClearToMatchStyle
eingebettetesdiagramm.Chart.HasTitle = True
eingebettetesdiagramm.Chart.ChartTitle.Text = bezeichnung
'eingebettetesdiagramm.Chart.ChartTitle.format.TextFrame2.TextRange.Font.Size = 11
'eingebettetesdiagramm.Chart.SetElement (msoElementDataLabelOutSideEnd)
'eingebettetesdiagramm.Chart.SetElement (msoElementDataLabelNone)
'eingebettetesdiagramm.Chart.SetElement (msoElementDataTableWithLegendKeys)
'eingebettetesdiagramm.Chart.SetElement (msoElementLegendNone)
eingebettetesdiagramm.Chart.Axes(xlCategory).TickLabelPosition = xlLow
eingebettetesdiagramm.Chart.SetElement (msoElementDataLabelOutSideEnd)
Dim seriescol As Integer, startseriescol As Integer
seriescol = eingebettetesdiagramm.Chart.SeriesCollection.Count
For startseriescol = 1 To seriescol
eingebettetesdiagramm.Chart.FullSeriesCollection(startseriescol).DataLabels.Position = xlLabelPositionCenter
eingebettetesdiagramm.Chart.FullSeriesCollection(startseriescol).DataLabels.Orientation = xlUpward
eingebettetesdiagramm.Chart.FullSeriesCollection(startseriescol).DataLabels.Font.Size = 12
Next
'Alles nach unten schieben
Rows("1:33").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(34, 1).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell