Office: (Office 2019) Füllfläche XY-Diagramm

Servus Leute!

Hätte eine Frage zu einem XY-Diagramm...
Und zwar suche ich eine Möglichkeit, die Fläche zwischen den beiden Linien farbig zu füllen (siehe Anhang).
Kann mir jmd. weiterhelfen?

 

Hi,

das geht mit VBA. Dazu müsstest du aber deine Mappe mit dem Diagramm hochladen, damit man den Code auch testen kann.

---

 

Die Grafiken sind auf der Folie ULS-Nachweis Biegespannung drin

 

Die Datenreihe mit den eigentlichen Daten ist nicht in allen Diagrammen identisch benannt, was das Erstellen des Codes wesentlich und unnötig erschwert und somit verzögert hat - du hast diesen Datenreihen nicht so wie den anderen Datenreihen einen spezifischen Namen gegeben sondern den automatisch von Excel erstellten Namen belassen und so heißt sie mal Datenreihen1 und mal Datenreihen3, je nachdem, in welcher Reihenfolge du sie erstellt hast. Benenne diese Datenreihe in allen Diagrammen also identisch um (z.B. "MeineDaten"), dann kannst du die Flächen mit folgendem Makro erstellen:

Code:

Sub FleachenEinfuegen()
    Dim lngPunkte As Long
    Dim chrDia As ChartObject
    Dim serReihe As Series
    Dim serLinie As Series
    Dim shaShape As Shape
    Dim dbl0 As Double
    Dim dblStart As Double
    For Each chrDia In ActiveSheet.ChartObjects
    With chrDia.Chart
        If .Shapes.Count > 0 Then
            For Each shaShape In .Shapes
                If shaShape.Name = "MeineFlaeche" Then shaShape.Delete
            Next shaShape
        End If
        For Each serReihe In .SeriesCollection
            If serReihe.Name = "0-Linie" Then
                dbl0 = serReihe.Points(1).Left
                dblStart = serReihe.Points(1).Top
            End If
            If serReihe.Name = "MeineDaten" Then Set serLinie = serReihe  '<== Name anpassen!!
        Next serReihe
        With .Shapes.BuildFreeform(msoEditingAuto, dbl0, dblStart)
            For lngPunkte = 1 To serLinie.Points.Count
                If IsEmpty(serLinie.XValues(lngPunkte)) Then Exit For
                .AddNodes msoSegmentLine, msoEditingAuto, serLinie.Points(lngPunkte).Left, serLinie.Points(lngPunkte).Top
            Next lngPunkte
            .AddNodes msoSegmentLine, msoEditingAuto, dbl0, serLinie.Points(serLinie.Points.Count).Top
            .AddNodes msoSegmentLine, msoEditingAuto, dbl0, serLinie.Points(1).Top
            .ConvertToShape
        End With
        With .Shapes(.Shapes.Count)
            .Name = "MeineFlaeche"
            .Fill.Transparency = 0.45
            .Fill.ForeColor.RGB = 255
            .Line.Visible = msoFalse
            .Top = .Top - 0.5
            If serLinie.Points.Count > 28 Then
                .ScaleHeight 0.996, msoFalse, msoScaleFromTopLeft
            Else
                .ScaleHeight 0.99, msoFalse, msoScaleFromTopLeft
            End If
        End With
    End With
    Next chrDia
    Set chrDia = Nothing
End Sub

Beachte: dieser Code gilt ausschließlich für die Diagramme in dieser Arbeitsmappe, das sie den selben Aufbau haben. Das Prinzip ist zwar für jedes andere Diagramm auch anwendbar, muss aber immer individuell an die konkreten Gegebenheiten angepasst werden.

---

 

Servus Danke mal für die Rückmeldung.
Hab das mal ausprobiert als Test, bei der ursprünglichen Mappe kam gleich "laufzeitfehler 91 objektvariable oder with-blockvariable nicht festgelegt"
und das diagramm sieht dann so aus...
Woran liegt denn das?

 

Das halte ich für ein Gerücht...

---

 

Und was deine heute um 19:24 Uhr hochgeladene Mappe betrifft kann ich nur sagen, dass du meinen Beitrag, in dem ich den Code gepostet hatte, nicht richtig gelesen hast:

In deiner zuletzt hochgeladenen Mappe ist das Diagramm nämlich anders aufgebaut als in deiner ursprünglichen Mappe vom Mittwoch 14:07 - du musst dich also nicht wundern, dass das Ergebnis nicht deinen Erwartungen entspricht. In dieser neuen Mappe:

1. schließt die 0-Linie nicht wie in deiner zuerst hochgeladenen Mappe mit dem hiedrigsten und höchsten Y-Wert der Datenreihe mit den Spannungswerten ab sondern hat unten und oben jeweils einen Y-Wert mehr - der ursprüngliche Code nimmt aber den oberen und unteren Abschluss für das Shape aus genau diesen beiden Datenpunkten.

2. heißt die 0-Linie nicht mehr 0-Linie wie in deiner Ausgangsdatei - ich hatte nicht geschrieben, dass du ALLE Datenreihen "MeineDaten" nennen sollst sondern nur diejenige mit den eigentlichen Werten, und zwar die Datenreihen, die in deiner ursprünglichen Mappe entweder Datenreihen1 oder Datenreihen3 von Excel automatisch benannt waren, damit sie (und NUR SIE) in allen Diagrammen denselben eindeutigen Namen haben. Alle anderen Datenreihen hattest du ja mit jeweils einem eindeutigen Namen benannt, der für alle Diagramme jeweils derselbe ist.

3. liegt die 0-Linie hier auf der Vertikalachse, in der ursprünglichen Mappe war die Horizontalachse so formatiert, dass die Vertikalachse beim maximalen Achsenwert schneidet.

Benenne die Datenreihe (die jetzt mit der Position der Vertikalachse zusammenfällt) um, und zwar wieder in 0-Linie, dann lässt sich der Code problemlos wie folgt anpassen:

Code:

Sub FleachenEinfuegen()
    Dim lngPunkte As Long
    Dim chrDia As ChartObject
    Dim serReihe As Series
    Dim serLinie As Series
    Dim shaShape As Shape
    Dim dbl0 As Double
    Dim dblStart As Double
    For Each chrDia In ActiveSheet.ChartObjects
    With chrDia.Chart
        If .Shapes.Count > 0 Then
            For Each shaShape In .Shapes
                If shaShape.Name = "MeineFlaeche" Then shaShape.Delete
            Next shaShape
        End If
        For Each serReihe In .SeriesCollection
            If serReihe.Name = "0-Linie" Then dbl0 = serReihe.Points(1).Left
            If serReihe.Name = "MeineDaten" Then
                Set serLinie = serReihe
                dblStart = serReihe.Points(1).Top
            End If
        Next serReihe
        With .Shapes.BuildFreeform(msoEditingAuto, dbl0, dblStart)
            For lngPunkte = 1 To serLinie.Points.Count
                If IsEmpty(serLinie.XValues(lngPunkte)) Then Exit For
                .AddNodes msoSegmentLine, msoEditingAuto, serLinie.Points(lngPunkte).Left, serLinie.Points(lngPunkte).Top
            Next lngPunkte
            .AddNodes msoSegmentLine, msoEditingAuto, dbl0, serLinie.Points(serLinie.Points.Count).Top
            .AddNodes msoSegmentLine, msoEditingAuto, dbl0, serLinie.Points(1).Top
            .ConvertToShape
        End With
        With .Shapes(.Shapes.Count)
            .Name = "MeineFlaeche"
            .Fill.Transparency = 0.45
            .Fill.ForeColor.RGB = 255
            .Line.Visible = msoFalse
        End With
    End With
    Next chrDia
    Set chrDia = Nothing
End Sub

---

[/QUOTE]

 

Hat funktioniert, danke dir für die Hilfe und sorry wegen der Unklarheiten... hab im 2. Sem das letzte Mal mit VBA was gemacht.

 

Dein Diagramm kann man übrigens aus 1 einzigen Datenreihe anstatt aus 4 Datenreihen und damit wesentlich einfacher erstellen, was natürlich den Code unkomplizierter macht - man muss nicht erst den Datenreihennamen ermitteln sondern kann einfach die 1. Datenreihe ansprechen, weil Start- und Endpunkt der Freihandform dann der 1. Datenpunkt dieser einen Datenreihe sind.

Für deine (fehlenden) VBA-Kenntnisse musst du dich nicht entschuldigen , dafür gibt es ja dieses Forum um dabei zu helfen, diese aufzufrischen und/oder zu erweitern. Und falls du Fragen zum Code hast - dann stelle sie einfach.

---