XY-Diagramm, Fläche unter Linie füllen
Joachim
ich will die Fläche unter eine xy-Diagramm füllen. Das Diagramm selbst wird über Makros formatiert.
siehe
Im Internet hab ich schon gegooglet und folgendes (leider noch nicht) passendes gefunden:
Sub ShadeBelow()
Dim myCht As Chart
Dim mySrs As Series
Dim Npts As Integer, Ipts As Integer
Dim myBuilder As FreeformBuilder
Dim myShape As Shape
Dim Xnode As Double, Ynode As Double
Dim Xmin As Double, Xmax As Double
Dim Ymin As Double, Ymax As Double
Dim Xleft As Double, Ytop As Double
Dim Xwidth As Double, Yheight As Double
Set myCht = ActiveChart
Xleft = myCht.PlotArea.InsideLeft
Xwidth = myCht.PlotArea.InsideWidth
Ytop = myCht.PlotArea.InsideTop
Yheight = myCht.PlotArea.InsideHeight
Xmin = myCht.Axes(1).MinimumScale
Xmax = myCht.Axes(1).MaximumScale
Ymin = myCht.Axes(2).MinimumScale
Ymax = myCht.Axes(2).MaximumScale
Set mySrs = myCht.SeriesCollection(1)
Npts = mySrs.Points.Count
' first point
Xnode = Xleft + (mySrs.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
Set myBuilder = myCht.Shapes.BuildFreeform(msoEditingAuto, Xnode, Ynode)
' remaining points
For Ipts = 1 To Npts
Xnode = Xleft + (mySrs.XValues(Ipts) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - mySrs.Values(Ipts)) * Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Next
Xnode = Xleft + (mySrs.XValues(Npts) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Xnode = Xleft + (mySrs.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Set myShape = myBuilder.ConvertToShape
With myShape
' USE YOUR FAVORITE COLORS HERE
.Fill.ForeColor.SchemeColor = 12
.Line.Visible = False
End With
End Sub
Wie kireg ich es hin, dass die shape bei 260 endet und nicht darüber hinausragt?
Und wie lösch ich die shape? Mit with .delete gehts nicht.
Gruss
Joachim