-
Solved: Charts automation using vba, works with Excel 2007 but error with 2003.
Hi All,
First timer, learned a lot from this site and it's people. Thanks!
Couldn't find a solution for this one.
The purpose of the code: Generating a chart in a new sheet ("Charts") for each parameter in the data sheet ("IW Composition") that it's CheckBox was selected.
The problem: Code works fine with Excel 2007 but error with 2003. The file is saved as 97-2003 Excel workbook.
The Error: "Run-time error '1004': Unable to set the HasTitle property of the Chart class". If omitted (with the "ChartTitle.Text" property line), the error occurs for the next property line.
Thx,
Kobi.
[vba]
Option Explicit
Sub CreateCharts()
Dim ChBox As CheckBox
Dim ChartName As String
Dim NumOfChk As Integer
Dim Results As Range
Dim rCells As Range
Dim LCL As Range
Dim UCL As Range
Dim Newsh As Worksheet
ThisWorkbook.Unprotect Password:="pass"
NumOfChk = 0
For Each ChBox In ActiveSheet.CheckBoxes
If ChBox.Value = xlOn Then
NumOfChk = NumOfChk + 1
End If
Next
Set ChBox = Nothing
If NumOfChk = 0 Then
MsgBox "None of the parameter was selected for charting."
Else
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("Charts").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set Newsh = ThisWorkbook.Worksheets.Add
Newsh.Name = "Charts"
Newsh.Move After:=Sheets("IW Composition")
Sheets("IW Composition").Select
For Each ChBox In Sheets("IW Composition").CheckBoxes
If ChBox.Value = xlOn Then
Set rCells = Range(Sheets("IW Composition").CheckBoxes _
(ChBox.Index).TopLeftCell.Address).Offset(1, 1)
ChartName = rCells.Value
Set rCells = Range(Sheets("IW Composition").CheckBoxes _
(ChBox.Index).TopLeftCell.Address).Offset(1, 5)
Set Results = rCells.Resize(1, 52)
Set rCells = Range(Sheets("IW Composition").CheckBoxes _
(ChBox.Index).TopLeftCell.Address).Offset(1, 78)
Set LCL = rCells.Resize(1, 2)
Set rCells = Range(Sheets("IW Composition").CheckBoxes _
(ChBox.Index).TopLeftCell.Address).Offset(1, 80)
Set UCL = rCells.Resize(1, 2)
With Sheets("Charts").ChartObjects.Add(Left:=100, Width:=650, Top:=500, Height:=225)
.Chart.ChartType = xlXYScatterLines
.Chart.HasLegend = False
.Chart.HasTitle = True
.Chart.ChartTitle.Text = ChartName
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(1).Name = ChartName
.Chart.SeriesCollection(1).XValues = "='IW Composition'!$F$1:$BE$1"
.Chart.SeriesCollection(1).Values = Results
.Chart.SeriesCollection(1).Border.ColorIndex = 1
.Chart.SeriesCollection(1).Border.Weight = 3
.Chart.SeriesCollection(1).MarkerSize = 5
.Chart.SeriesCollection(1).MarkerBackgroundColorIndex = 11
.Chart.SeriesCollection(1).MarkerForegroundColorIndex = 11
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(2).Name = "Lower Control Limit"
.Chart.SeriesCollection(2).XValues = "='IW Composition'!$CA$4:$CB$4"
.Chart.SeriesCollection(2).Values = LCL
.Chart.SeriesCollection(2).Border.ColorIndex = 3
.Chart.SeriesCollection(2).Border.Weight = 3
.Chart.SeriesCollection(2).MarkerStyle = -4142
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(3).Name = "Upper Control Limit"
.Chart.SeriesCollection(3).XValues = "='IW Composition'!$CC$4:$CD$4"
.Chart.SeriesCollection(3).Values = UCL
.Chart.SeriesCollection(3).Border.ColorIndex = 3
.Chart.SeriesCollection(3).Border.Weight = 3
.Chart.SeriesCollection(3).MarkerStyle = -4142
.Chart.ChartArea.Border.ColorIndex = 1
.Chart.ChartArea.Border.Weight = 4
.Chart.PlotArea.Border.ColorIndex = 1
.Chart.PlotArea.Border.Weight = 1
.Chart.PlotArea.Interior.ColorIndex = 15
.Chart.Axes(xlCategory).HasTitle = True
.Chart.Axes(xlCategory).AxisTitle.Text = "WW"
.Chart.Axes(xlCategory).MinimumScale = 1
.Chart.Axes(xlCategory).MaximumScale = 52
.Chart.Axes(xlCategory).MinorUnit = 1
.Chart.Axes(xlCategory).MajorUnit = 1
ChBox.Value = xlOff
End With
End If
Next
ArrangeMyCharts
End If
ThisWorkbook.Protect Password:="pass"
Application.ScreenUpdating = True
End Sub
[/vba]
-
Can you post a workbook for testing?
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
-
File attached. Use "cylon" to unprotect.
The relevant code is in CreateCart module.
Thanks.
-
This code works in both xl2007 and 2003.
The chart needs at least 1 series before you can set the chart title.
I have also changed the range references to R1C1 notation to avoid other 2003 errors.
[vba]
Sub CreateCharts()
Dim ChBox As CheckBox
Dim ChartName As String
Dim NumOfChk As Integer
Dim Results As Range
Dim rCells As Range
Dim LCL As Range
Dim UCL As Range
Dim Newsh As Worksheet
Dim UserAuthorized As Boolean
ThisWorkbook.Unprotect Password:="cylon"
NumOfChk = 0
For Each ChBox In ActiveSheet.CheckBoxes
If ChBox.Value = xlOn Then
NumOfChk = NumOfChk + 1
End If
Next
Set ChBox = Nothing
If NumOfChk = 0 Then
MsgBox "None of the parameter was selected for charting."
Else
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("Charts").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set Newsh = ThisWorkbook.Worksheets.Add
Newsh.Name = "Charts"
Newsh.Move After:=Sheets("IW Composition")
Sheets("IW Composition").Select
For Each ChBox In Sheets("IW Composition").CheckBoxes
If ChBox.Value = xlOn Then
Set rCells = Range(Sheets("IW Composition").CheckBoxes _
(ChBox.Index).TopLeftCell.Address).Offset(1, 1)
ChartName = rCells.Value
Set rCells = Range(Sheets("IW Composition").CheckBoxes _
(ChBox.Index).TopLeftCell.Address).Offset(1, 5)
Set Results = rCells.Resize(1, 52)
Set rCells = Range(Sheets("IW Composition").CheckBoxes _
(ChBox.Index).TopLeftCell.Address).Offset(1, 78)
Set LCL = rCells.Resize(1, 2)
Set rCells = Range(Sheets("IW Composition").CheckBoxes _
(ChBox.Index).TopLeftCell.Address).Offset(1, 80)
Set UCL = rCells.Resize(1, 2)
With Sheets("Charts").ChartObjects.Add(Left:=100, Width:=650, Top:=500, Height:=225)
.Chart.ChartType = xlXYScatterLines
.Chart.HasLegend = False
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(1).Name = ChartName
.Chart.SeriesCollection(1).XValues = "='IW Composition'!R1C6:R1C57"
.Chart.SeriesCollection(1).Values = Results
.Chart.SeriesCollection(1).Border.ColorIndex = 1
.Chart.SeriesCollection(1).Border.Weight = 3
.Chart.SeriesCollection(1).MarkerSize = 5
.Chart.SeriesCollection(1).MarkerBackgroundColorIndex = 11
.Chart.SeriesCollection(1).MarkerForegroundColorIndex = 11
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(2).Name = "Lower Control Limit"
.Chart.SeriesCollection(2).XValues = "='IW Composition'!R4C79:R4C80"
.Chart.SeriesCollection(2).Values = LCL
.Chart.SeriesCollection(2).Border.ColorIndex = 3
.Chart.SeriesCollection(2).Border.Weight = 3
.Chart.SeriesCollection(2).MarkerStyle = -4142
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(3).Name = "Upper Control Limit"
.Chart.SeriesCollection(3).XValues = "='IW Composition'!R4C81:R4C82"
.Chart.SeriesCollection(3).Values = UCL
.Chart.SeriesCollection(3).Border.ColorIndex = 3
.Chart.SeriesCollection(3).Border.Weight = 3
.Chart.SeriesCollection(3).MarkerStyle = -4142
.Chart.HasTitle = True
.Chart.ChartTitle.Text = ChartName
.Chart.ChartArea.Border.ColorIndex = 1
.Chart.ChartArea.Border.Weight = 4
.Chart.PlotArea.Border.ColorIndex = 1
.Chart.PlotArea.Border.Weight = 1
.Chart.PlotArea.Interior.ColorIndex = 15
.Chart.Axes(xlCategory).HasTitle = True
.Chart.Axes(xlCategory).AxisTitle.Text = "WW"
.Chart.Axes(xlCategory).MinimumScale = 1
.Chart.Axes(xlCategory).MaximumScale = 52
.Chart.Axes(xlCategory).MinorUnit = 1
.Chart.Axes(xlCategory).MajorUnit = 1
ChBox.Value = xlOff
End With
End If
Next
ArrangeMyCharts
End If
ThisWorkbook.Protect Password:="cylon"
Application.ScreenUpdating = True
End Sub
[/vba]
-
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules