Chart creation ceiling in Excel 2002 via Chart.Add ?

  • Thread starter Thread starter Daniel S.
  • Start date Start date
D

Daniel S.

I'm somewhat new to VB and Excel automation, so I am probably doing
something stupid. I'm generating bar charts, saving them as GIF
files. The vb macro always dies with errors after around 5500 graphs,
sometimes leaving a Chart5500 worksheet open in the spreadsheet.
Excel has to be restarted to re-run the macro. In the VBAProject
window, under Excel Objects, the chart macro keeps incrementing Chart1
to Chart5500 as the charts are created and deleted. Memory usage does
not max out during the graph creation process. The debugger stops at
the Chart.Add line. This has happened on several computers.

Any ideas what I'm doing wrong?

Code is as below for graph creation:

Public Sub MakeGraph(chartid As String, suffix As String, xLabel As
String, expt As String)
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData source:=Sheets("Sheet3").Range("A2:B3"),
PlotBy:= _
xlRows
ActiveChart.SeriesCollection(1).Name = "=Sheet3!R7C1"
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet3"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = _
chartid
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text =
yLabel
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Y
Value"
End With
ActiveChart.HasLegend = False
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ErrorBar Direction:=xlY,
Include:=xlBoth, _
Type:=xlCustom, Amount:="=Sheet3!R4C1:R4C2", MinusValues:= _
"=Sheet3!R4C1:R4C2"
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.Font.Bold = True
ActiveChart.ChartTitle.Select
Selection.Font.Bold = True
ActiveChart.ChartArea.Select
ActiveChart.Axes(xlValue).Select
With ActiveChart.Parent
.Width = 600
.Height = 300
End With
Selection.TickLabels.Font.Bold = True
''' Color selection
Dim colnum As Integer
colnum = 1
''' Color columns conditionally
Do While Worksheets("Sheet3").Cells(5, colnum).Value <> ""
' MsgBox (Worksheets("Sheet3").Cells(5, colnum))
If (Worksheets("Sheet3").Cells(5, colnum).Value < 1) Then
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(colnum).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 54
.Pattern = xlSolid
End With
End If
colnum = colnum + 1
Loop
''' Export graph as gif
Dim FileName As String
FileName = "C:\JUNK\" + suffix + "\" + chartid + "." + suffix +
".gif"
FileName = Replace(FileName, "/", "_")
ActiveChart.Export FileName:=FileName, FilterName:="GIF"
''' Saved, now wipe to save memory
ActiveChart.Parent.Delete
''' Also tried with
Activesheet.ChartObjects.Delete
''' Doesn't help
End Sub
 
Can't say why it is happening, but why not do 5000 at a time, closing and
reopening Excel in between.

Regards,
Tom Ogilvy
 
Another approach: don't keep deleting and adding charts. Just reuse one
chart, change its source data range and other particulars and export it,
then repeat as needed.

- Jon
 
Jon Peltier said:
Another approach: don't keep deleting and adding charts. Just reuse one
chart, change its source data range and other particulars and export it,
then repeat as needed.

- Jon
Click to expand...

Thanks for the tip Jon! Much cleaner and faster. I did run into the
"too many fonts for this worksheet" bug when using the same chart and
repopulating it, thus I had to add the "AutoScaleFont = False"
statement, and also set AutoScaleFont = False in the separate chart
creation Sub.

Great web site as well.

The codeblock I used is below:

Public Sub GraphExport(TitleId As String, suffix As String, xLabel As
String, expt As String)
''' Select precreated chart, only create once
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.Select
''' Required to avoid too many fonts bug
Selection.AutoScaleFont = False
With ActiveChart
.ChartTitle.Characters.Text = _
expt + " for " + ChartId
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Units"
End With
ActiveChart.HasLegend = False
ActiveChart.SeriesCollection(1).Select
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.Font.Bold = True
ActiveChart.ChartTitle.Select
Selection.Font.Bold = True
ActiveChart.ChartArea.Select
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.Font.Bold = True
With ActiveChart.Parent
.Width = 600
.Height = 300
End With
Selection.TickLabels.Font.Bold = True
''' Export file
Dim FileName As String
FileName = "C:\JUNK\" + suffix + "\" + ProbeId + "_" + suffix +
".gif"
FileName = Replace(FileName, "/", "_")
ActiveChart.Export FileName:=FileName, FilterName:="GIF"
End Sub
 
Back
Top