Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hi All,
I've written a macro (code below) to create a series of XY scatter charts in the same workbook. The first time through the loop, everything works exactly as it should and I get the desired graph. The second time through, the Charts.Add command adds a chart sheet but doesn't add a chart - I just have a blank white space. When the code gets to the 'ActiveChart.HasTitle = True' line the following error appears:Run-time error '1004' Method 'HasTitle' of object '_Chart' failed. I've got absolutely no idea what might be causing this problem and any help would be greatly appreciated! Regards, -- Chris Sub Armour_Subarmour_GSD_Plots() 'Before starting the macro set the Activecell to "A1" 'Application.ScreenUpdating = False 'Set the row and column indices to cell D11 RI = 11 CI = 5 Do 'Set the name of the chart ChartName = ActiveCell.Value & " " & ActiveCell.Offset(2, 1).Value _ & "m plot" 'Set the names of the armour & sub-armour data series If IsEmpty(ActiveCell.Offset(3, 1)) And _ ActiveCell.Offset(4, 1).Value = "Armour" Then Series1Name = ActiveCell.Offset(2, 1).Value & "m Armour" Series2Name = ActiveCell.Offset(2, 1).Value & _ "m Sub-armour" End If 'Create a new XY scatter plot as a new chart sheet Charts.Add ActiveChart.Location Whe=xlLocationAsNewSheet, _ Name:=ChartName ActiveChart.ChartType = xlXYScatterLines 'Set the formatting for all chart elements 'Set all chart title formatting ActiveChart.HasTitle = True With ActiveChart.ChartTitle .Characters.Text = "Grain Size Distribution" .Font.Size = 16 .Font.Bold = True End With 'Set all X-axis formatting With ActiveChart.Axes(xlCategory, xlPrimary) ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Select With Selection .Characters.Text = "Grain Size (mm)" .Font.Size = 12 .Font.Bold = True End With .MinimumScale = 0.01 .MaximumScale = 100 .Crosses = xlCustom .CrossesAt = 0.01 .ScaleType = xlLogarithmic .HasMajorGridlines = True .HasMinorGridlines = True .DisplayUnit = xlNone ActiveChart.Axes(xlCategory, xlPrimary).Select With Selection.TickLabels .Font.Size = 10 .Font.Bold = True End With With Selection .MinorTickMark = xlOutside End With End With 'Set all Y-axis formatting With ActiveChart.Axes(xlValue, xlPrimary) ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Select With Selection .Characters.Text = "Percent finer than" .Font.Size = 12 .Font.Bold = True End With .MinimumScale = 0 .MaximumScale = 100 .MinorUnit = 2 .MajorUnit = 10 ActiveChart.Axes(xlValue, xlPrimary).Select With Selection.TickLabels .Font.Size = 10 .Font.Bold = True .NumberFormat = "0" End With With Selection .MinorTickMark = xlOutside End With End With 'Set all Legend formatting & re-adjust plot area With ActiveChart.Legend .Left = 490 .Top = 327 .Width = 160 .Height = 58 .Font.Bold = True End With ActiveChart.PlotArea.Select Selection.Width = 645 Worksheets("Run11").Activate 'Adds the Armour and Sub-armour data series to the same chart If ActiveCell.Offset(4, 1).Value = "Armour" Then Charts(ChartName).Activate 'Add series 1 (Armour or Surface) data to the chart With ActiveChart.SeriesCollection(1) .XValues = Worksheets("Run11").Range("B11:B24") .Values = Worksheets("Run11").Range(Worksheets("Run11") _ .Cells(RI, CI), Worksheets("Run11").Cells _ (RI + 13, CI)) .Name = Series1Name End With 'Add series 2 (Sub-armour or Sub-surface) and its 'data to the chart ActiveChart.SeriesCollection.NewSeries With ActiveChart.SeriesCollection(2) .XValues = Worksheets("Run11").Range("B11:B24") .Values = Worksheets("Run11").Range(Worksheets("Run11") _ .Cells(RI, CI + 11), Worksheets("Run11").Cells _ (RI + 13, CI + 11)) .Name = Series2Name End With End If Worksheets("Run11").Activate 'Adds all the Bulk data series to the same chart If ActiveCell.Offset(4, 1).Value = "Bulk" Then i = 0 Do Charts(ChartName).Activate i = i + 1 With ActiveChart.SeriesCollection(i) .XValues = Worksheets("Run11").Range("B11:B24") .Values = Worksheets("Run11").Range(Worksheets("Run11") _ .Cells(RI, CI), Worksheets("Run11").Cells _ (RI + 13, CI)) .Name = ActiveCell.Offset(2, 1).Value & " " & _ ActiveCell.Offset(4, 1).Value End With Worksheets("Run11").Activate If ActiveCell.Offset(4, 12).Value = "Bulk" Then Charts(ChartName).Activate ActiveChart.SeriesCollection.NewSeries Worksheets("Run11").Activate ActiveCell.Offset(0, 11).Select End If Loop While ActiveCell.Offset(4, 1).Value = "Bulk" End If 'Update the column Index and ActiveCell locations If ActiveCell.Offset(4, 1).Value = "Armour" And _ ActiveCell.Offset(4, 23).Value = "Armour" Then CI = CI + 22 Worksheets("Run11").Activate ActiveCell.Offset(0, 22).Select End If If ActiveCell.Offset(4, 1).Value = "Armour" And _ IsEmpty(ActiveCell.Offset(4, 23)) Then Worksheets("Run11").Activate ActiveCell.Offset(0, 22).Select End If If ActiveCell.Offset(4, 1).Value = "Armour" And _ ActiveCell.Offset(4, 23).Value = "Bulk" Then CI = CI + 22 Worksheets("Run11").Activate ActiveCell.Offset(0, 22).Select End If If ActiveCell.Offset(4, 1).Value = "Bulk" And _ ActiveCell.Offset(4, 23).Value = "Bulk" Then CI = CI + 11 Worksheets("Run11").Activate ActiveCell.Offset(0, 11).Select End If If ActiveCell.Offset(4, 1).Value = "Bulk" And _ IsEmpty(ActiveCell.Offset(4, 12)) Then Worksheets("Run11").Activate ActiveCell.Offset(0, 22).Select End If 'Tell the code what to do if all the samples from that 'sampling interval have been processed If IsEmpty(ActiveCell.Offset(4, 1)) Then ActiveCell.Offset(40, 0).Select ActiveCell.End(xlToLeft).Select RI = RI + 40 CI = 5 End If Loop Until IsEmpty(ActiveCell.Offset(4, 1)) End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Adding criteria to loop | Excel Worksheet Functions | |||
Use a loop to create multiple Charts - Suggestions ? | Charts and Charting in Excel | |||
Adding in loop | Charts and Charting in Excel | |||
HELP!!!! Can't stop a loop (NOT an infinite loop) | Excel Programming | |||
Loop through sheets, deselect charts | Excel Programming |