Option
Explicit
Private
Type tChartProps
sChartName
As
String
dblLefts
As
Double
dblTops
As
Double
lngID
As
Long
End
Type
Sub
CreateCharts()
Dim
dLeft
As
Double
, dWidth
As
Double
, lHeight
As
Double
, dTop
As
Double
Dim
i
As
Long
, ii
As
Long
Dim
rng
As
Excel.Range
Dim
c
As
Excel.Range
Dim
oCharts()
As
tChartProps
dTop = Application.CentimetersToPoints(7.5)
dLeft = Application.CentimetersToPoints(5)
dWidth = Application.CentimetersToPoints(5)
lHeight = Application.CentimetersToPoints(5)
Set
rng = Range(
"A1:A30"
)
ReDim
oCharts(1
To
rng.Rows.Count)
For
i = 1
To
rng.Rows.Count / 10
For
ii = 1
To
10
oCharts(ii + ((i * 10) - 10)).lngID = ii + ((i * 10) - 10)
oCharts(ii + ((i * 10) - 10)).dblLefts = (ii * Application.CentimetersToPoints(12.75))
oCharts(ii + ((i * 10) - 10)).dblTops = (i * dTop) + dWidth
Next
ii
Next
i
For
Each
c
In
rng
ActiveSheet.Shapes.AddChart2(XlChartType:=xlXYScatterSmoothNoMarkers).Name = c.Text
ActiveSheet.Shapes(c.Text).
Select
ActiveChart.SetSourceData Source:=Range(c.Parent.Name &
"!"
& c.Resize(c.Rows.Count, c.
End
(xlToRight).Column).Address)
ActiveChart.ChartTitle.Text = c.Text
oCharts(c.Row).sChartName = c.Text
ActiveSheet.Shapes(oCharts(c.Row).sChartName).Left = oCharts(c.Row).dblLefts
ActiveSheet.Shapes(oCharts(c.Row).sChartName).Top = oCharts(c.Row).dblTops
Next
c
End
Sub