Hi all
I use a macro to shade a area under a line in a graph:
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 ' kleur instellen
.Fill.ForeColor.SchemeColor = 2
.Fill.Transparency = 0.8
.Line.Visible = False
End With
End Sub
I want to adjust this so that it shades area''s under or above all the lines in that graph lines.
Preferreble shading above the line/under/no shading depends on a number (reference) in a cell. So that I can make a checkbox for the user. And the macro loops until it has executed all the preset wishes for all the lines that are present.
btw, the scrip I use for shading abice the line is the following. The part I marked red is how I tried to make it loop for or the lines. It does repeat the shading for each line, but the are all in the same place, because the location is not adjusted to match the area under (or above) the second line. And also there is no choise between above/under or no shading.
Can anybody help me adjust these scripts?
Bas
Dim myCht As Chart
Dim mySrs As Series, Isrs As Integer
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
For Isrs = 1 To myCht.SeriesCollection.Count
Set mySrs = myCht.SeriesCollection(1)
Npts = mySrs.Points.Count
' first point
Xnode = Xleft
Ynode = Ytop + (Ymax - mySrs.Values(1)) * Yheight / (Ymax - Ymin)
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
Ynode = Ytop + (Ymax - mySrs.Values(1)) * Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Xnode = Xleft
Ynode = Ytop + (Ymax - mySrs.Values(1)) * Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Set myShape = myBuilder.ConvertToShape
With myShape ' kleur instellen
.Fill.ForeColor.SchemeColor = 2
.Fill.Transparency = 0.8
.Line.Visible = False
End With
Next
End Sub
I use a macro to shade a area under a line in a graph:
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 ' kleur instellen
.Fill.ForeColor.SchemeColor = 2
.Fill.Transparency = 0.8
.Line.Visible = False
End With
End Sub
I want to adjust this so that it shades area''s under or above all the lines in that graph lines.
Preferreble shading above the line/under/no shading depends on a number (reference) in a cell. So that I can make a checkbox for the user. And the macro loops until it has executed all the preset wishes for all the lines that are present.
btw, the scrip I use for shading abice the line is the following. The part I marked red is how I tried to make it loop for or the lines. It does repeat the shading for each line, but the are all in the same place, because the location is not adjusted to match the area under (or above) the second line. And also there is no choise between above/under or no shading.
Can anybody help me adjust these scripts?
Bas
Dim myCht As Chart
Dim mySrs As Series, Isrs As Integer
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
For Isrs = 1 To myCht.SeriesCollection.Count
Set mySrs = myCht.SeriesCollection(1)
Npts = mySrs.Points.Count
' first point
Xnode = Xleft
Ynode = Ytop + (Ymax - mySrs.Values(1)) * Yheight / (Ymax - Ymin)
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
Ynode = Ytop + (Ymax - mySrs.Values(1)) * Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Xnode = Xleft
Ynode = Ytop + (Ymax - mySrs.Values(1)) * Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Set myShape = myBuilder.ConvertToShape
With myShape ' kleur instellen
.Fill.ForeColor.SchemeColor = 2
.Fill.Transparency = 0.8
.Line.Visible = False
End With
Next
End Sub