Chart Shape Alignment

[Shaun]

Hi all


I have generated code to produce Open, High, Low, Close stock charts (Primary Axis) with two moving average lines (Secondary Axis) sharing a common Y axis (dates).


I wanted to create a fill with boundries equalling:

- bottom boundry = Min on Y axis

- top boundry = Close price

- left boundry = First High/Low line which I thought would be equal to Min on X axis

- right boundry = Last High/Low line which I thought would be equal to Max on X axis.


Jon Peltier had created some code to do exactly that:

[pre]

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(4)
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.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0.8
.Solid
End With
With myShape.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
End With
With myShape.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
End With
With myShape.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 1
End With

Though it never seems to line up correctly.


The issue I am having with it is that I then have to manually adjust the shape to "line up" with the first x Axis point and last X axis point. I have tried to remedy this by:

[pre][code]ActiveSheet.ChartObjects("OHLC").Activate
ActiveChart.Shapes.Range(Array("Freeform 1")).Select
ActiveChart.Shapes.Range(Array("Freeform 1")).Width = Xwidth
ActiveChart.Shapes.Range(Array("Freeform 1")).Left = Xleft

[/pre]

This is close, but the shape resizes slightly wider than high/low lines on the left and quiet a bit wider than the high/low lines on the right, but is a closer fit than the original shape produced. I have tried to change to:


ActiveChart.Shapes.Range(Array("Freeform 1&#34).Width = Xwidth - 61.5
ActiveChart.Shapes.Range(Array("Freeform 1&#34).Left = Xleft + 6[/code][/pre]
which lines up 1 stock perfectly but not others.


What is it that the " - 61.5" and the " + 6" are referring to that I am missing so that I can include in the above code to make it work on every graph generated?


Any help/advice would be greatly appreciated


Cheers


Shaun

 

[NARAYANK991]

Hi Shaun ,


I think going through only code and trying to solve a problem is not so easy , unless one has already faced the same problem and solved it.


If the data is available along with the code , things become that much easier.


If you can upload a sample workbook with random data and the code , it would make it easier for others to come up with a solution.


Narayan

 

[Shaun]

Hi All


I have prepared a dummy file to demonstrate the issue as suggested by Narayank991.


https://rapidshare.com/files/1056428909/bhp.xlsm


Cheers


Shaun

 

[NARAYANK991]

Hi Shaun ,


Can you try playing around with the following ?


1. I changed the options within the Format Horizontal Axis , so as to Position Axis on Tick Marks instead of Between Tick Marks.


2. I changed the option under Alignment Text Direction to Rotate all Text by 270 degrees.


3. Check the Activechart.PlotArea.Width ; it always comes out to be 789.


4. Check the Activechart.Shapes(1).Width ; it varies from 753.9389 to 755.4191 ; changing this value changes the size of your "Freeform 1" shape. The problem is that the amount you have to reduce this varies depending on the number of points that are plotted. For 8 points , you need to reduce it down to 718.5 before the image coincides with the graph.


Narayan

 

[Shaun]

Hi Narayank991


You're a genius!


Your first suggestion fixed the left side of the graph but not the right, then it occurred to me that there was in fact a second axis! I repeated on the second x axis and it worked beautifully.


The next step was to get those manual mouse clicks into VBA code, the result:


replace this

[pre]

ActiveChart.Axes(xlCategory).Select
Selection.Delete
with

[pre][code]ActiveChart.Axes(xlCategory, xlPrimary).Select
With ActiveChart.Axes(xlCategory, xlPrimary)
.TickLabels.Orientation = -90
End With
ActiveChart.Axes(xlCategory, xlPrimary).AxisBetweenCategories = False
ActiveChart.HasAxis(xlCategory, xlSecondary) = True
ActiveChart.Axes(xlCategory, xlSecondary).Select
ActiveChart.Axes(xlCategory, xlSecondary).AxisBetweenCategories = False
With ActiveChart.Axes(xlCategory, xlSecondary)
.TickLabels.Orientation = -90
.AxisBetweenCategories = False
End With
Selection.Delete
ActiveChart.Axes(xlCategory, xlPrimary).Select
Selection.Delete
ActiveChart.Parent.Name = "OHLC"
and this

ActiveChart.Parent.Name = "OHLC"
ActiveSheet.ChartObjects("OHLC").Activate
ActiveChart.Shapes.Range(Array("Freeform 1")).Select
ActiveChart.Shapes.Range(Array("Freeform 1")).Width = Xwidth
ActiveChart.Shapes.Range(Array("Freeform 1")).Left = Xleft

[/pre]
with this

Dim mySheet As Worksheet
Dim OHLCCht As ChartObject
Dim OHLCWidth As Long
Dim OHLCLeft As Long

Set mySheet = Worksheets("BHP.ax&#34
Set OHLCCht = mySheet.ChartObjects("OHLC&#34

With OHLCCht.Chart
With .PlotArea
OHLCLeft = .InsideLeft
OHLCWidth = .InsideWidth
End With
Debug.Print OHLCLeft, OHLCWidth
End With
ActiveSheet.ChartObjects("OHLC&#34.Activate
ActiveChart.Shapes.Range(Array("Freeform 1&#34).Select
ActiveChart.Shapes.Range(Array("Freeform 1&#34).Width = OHLCWidth
ActiveChart.Shapes.Range(Array("Freeform 1&#34).Left = OHLCLeft[/code][/pre]
It could probably have been done in a much "prettier" fashion but it works. I have applied those changes to the real spreadsheet and it works great.


I am still nowhere near Awesome at Excel, but today I have crawled a little closer!


Thank you again Narayank991!


Cheers


Shaun

 

[NARAYANK991]

Hi Shaun ,


Thank you. Good for you. Welcome back any time.


Narayan