Runtime Errror 1004 No more new fonts may be applied in this workb
 

continue to have problems placing a large amount of graphs on worksheets.

The program hangs on Runtime Error 1004: No more new fonts may be applied in
this workbook. Sometimes on Runtime Error 1004: Unable to se the HasTitle
propert of the exis class.

I have tried several methods

Dim ChtObj As ChartObject

Dim chtChart As Chart

then cleaning up at the end of each chart placement with

Set chtChart = Nothing


The total amount of datasets is 50
The maximum amount of graphs successfully placed on sheet2 is about 27
The most successful run was with the code below.

Does anyone have a solution to this problem?


Option Explicit
Dim p As Integer
Dim q As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim chartcounter As Integer
Dim chartcolumn As Integer
Dim countvalues As Integer
Dim countrecords As Integer
Dim offset As Integer
Dim var1 As String
Dim ChtObj As ChartObject
Dim chtChart As Chart
Dim mc As Range

Private Sub CommandButton1_Click()
z = 8
y = 5
q = 1
countvalues = 0
countrecords = 0
chartcounter = 1
chartcolumn = 0
offset = 1

Do While Sheet1.Cells(z, 1) < ""
countrecords = countrecords + 1
If Sheet1.Cells(z, 1) < Sheet1.Cells(z + 1, 1) Then

Sheet2.Activate
Set mc = ActiveSheet.Cells(chartcounter, 1)

chartcounter = chartcounter + 15

Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Sheet1.Range(Cells(z - countrecords + 1, y),
Cells(z - countrecords + countvalues, y + 1)), PlotBy _
:=xlColumns
ActiveChart.Location Whe=xlLocationAsObject, Name:="Sheet2"
With ActiveChart
..HasTitle = True
..ChartTitle.Characters.Text = Sheet1.Cells(z, 1) & " " &
Sheet1.Cells(1, y + 1)
..Axes(xlCategory, xlPrimary).HasTitle = True
..Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "date"
..Axes(xlValue, xlPrimary).HasTitle = True
..Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "concentration
mg/l"
End With
With ActiveChart.Parent
..Top = Range(mc.Address).Top
..Left = Range(mc.Address).Left
End With


countrecords = 0
countvalues = 0
End If
If Sheet1.Cells(z, y) < "" Then
countvalues = countvalues + 1
End If
z = z + 1
Loop

End Sub

Runtime Errror 1004 No more new fonts may be applied in this workb
 

Be sure you aren't using a huge amount of cell formatting as when you use a
numerous different formats and styles, you could very easily reach this
4,000 different cell formats limitation as one of my co-workers did. It
appears to be less than accurate on calculating the actual number of
*DIFFERENT* cell formats, but regardless, if you use quite a few of them,
you can reach and exceed this limit easily. I'm guessing this also applies
to charts too as part of that 4,000 count.

What's all included:

The format of the Cell
Font formats (Size, style, and the other stuff such as underline, subscript
and superscript)
Font Color
Cell Interior Color
Borders

I'm sure there's others, but these are the more common ones.

For other limitations such as on charts and workbooks, goto the contents of
Excel Help file (may have to disable the assistant help in order to get to
the ocntents as I hate the assistant help anyhow), then go through the
family tree:

Microsoft Excel Help
Installing and Removing Excel
Excel specifications and limits

--
Ronald R. Dodge, Jr.
Production Statistician
Master MOUS 2000

"Henri" wrote in message
...
continue to have problems placing a large amount of graphs on worksheets.

The program hangs on Runtime Error 1004: No more new fonts may be applied
in
this workbook. Sometimes on Runtime Error 1004: Unable to se the HasTitle
propert of the exis class.

I have tried several methods

Dim ChtObj As ChartObject

Dim chtChart As Chart

then cleaning up at the end of each chart placement with

Set chtChart = Nothing


The total amount of datasets is 50
The maximum amount of graphs successfully placed on sheet2 is about 27
The most successful run was with the code below.

Does anyone have a solution to this problem?


Option Explicit
Dim p As Integer
Dim q As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim chartcounter As Integer
Dim chartcolumn As Integer
Dim countvalues As Integer
Dim countrecords As Integer
Dim offset As Integer
Dim var1 As String
Dim ChtObj As ChartObject
Dim chtChart As Chart
Dim mc As Range

Private Sub CommandButton1_Click()
z = 8
y = 5
q = 1
countvalues = 0
countrecords = 0
chartcounter = 1
chartcolumn = 0
offset = 1

Do While Sheet1.Cells(z, 1) < ""
countrecords = countrecords + 1
If Sheet1.Cells(z, 1) < Sheet1.Cells(z + 1, 1) Then

Sheet2.Activate
Set mc = ActiveSheet.Cells(chartcounter, 1)

chartcounter = chartcounter + 15

Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Sheet1.Range(Cells(z - countrecords + 1, y),
Cells(z - countrecords + countvalues, y + 1)), PlotBy _
:=xlColumns
ActiveChart.Location Whe=xlLocationAsObject, Name:="Sheet2"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = Sheet1.Cells(z, 1) & " " &
Sheet1.Cells(1, y + 1)
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "date"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "concentration
mg/l"
End With
With ActiveChart.Parent
.Top = Range(mc.Address).Top
.Left = Range(mc.Address).Left
End With


countrecords = 0
countvalues = 0
End If
If Sheet1.Cells(z, y) < "" Then
countvalues = countvalues + 1
End If
z = z + 1
Loop

End Sub