I am using Excel on MacOS. The "About" information tells me it is version 16.16.5, which apparently corresponds to Office 2016. If you look at the code here and think "hey, that works for me", it would be great if you could leave a comment that includes the version of Excel you're using.
I have a spreadsheet in which I would like to copy charts from a "template" worksheet into approx. 80 other worksheets, and then modify them to refer to data on the destination sheet rather than the origin sheet (via a simple search-and-replace on the series).
This doesn't at first glance seem all that difficult, and there are lots of potential solutions both here on Stack Overflow and elsewhere, but I seem to keep running into unexpected behavior.
For the examples below, the code simply copies charts from one worksheet to another, rather than iterating over all the available worksheets, because that makes cleanup easier when it fails. Which, so far, is always.
My first attempt looked like this:
Sub Copy_Charts()
Dim DataSheetName1 As String, DataSheetName2 As String
Dim chartObj as ChartObject, chartObjCopy as ChartObject
Dim sourceChartSheet as Worksheet, destChartSheet as Worksheet
DataSheetName1 = "CU-2"
DataSheetName2 = "CU-8"
Set sourceChartSheet = Sheets(DataSheetName1)
Set destChartSheet = Sheets(DataSheetName2)
For Each chartObj In sourceChartSheet.ChartObjects
chartObj.Copy
destChartSheet.Range(chartObj.TopLeftCell.Address).PasteSpecial xlPasteAll
chartIndex = chartIndex + 1
Set chartObjCopy = destChartSheet.ChartObjects(chartIndex)
chartObjCopy.Left = chartObj.Left
chartObjCopy.Top = chartObj.Top
Next chartObj
End Sub
This almost works: it does in fact copy the charts to the destination worksheet. However, it fails at this line:
Set chartObjCopy = destChartSheet.ChartObjects(chartIndex)
The error is "Run-time error '1004': Application-defined or object-defined error".
And in fact, if you look at destChartSheet.ChartObjects.Count at this point, it still shows as 0
. Furthermore, if you attempt to delete the charts using code like this:
Sub Delete_Charts()
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Worksheets
If sht.Name <> "CU-2" Then
If sht.ChartObjects.Count >= 1 Then
sht.ChartObjects.Delete
End If
End If
Next sht
End Sub
It won't actually delete the charts. The same delete code works just fine if you copy and paste the charts by hand.
In summary: this code does copy the charts, but I can't get a reference to the copy in order to modify it, nor can I delete it.
I decided to throw copy-and-paste out the window and try the Duplicate
method instead. I ended up with the following:
Sub Copy_Charts()
Dim DataSheetName1 As String, DataSheetName2 As String
Dim sourceChartSheet As Worksheet, destChartSheet As Worksheet
Dim chartObj As ChartObject, newChartObj As ChartObject
Dim chartObjCopy As ChartObject
Dim chSeries As Series
Dim chartIndex As Integer
DataSheetName1 = "CU-2"
DataSheetName2 = "CU-8"
Set sourceChartSheet = Sheets("CU-2")
Set destChartSheet = Sheets("CU-8")
For Each chartObj In sourceChartSheet.ChartObjects
' No idea why chartObj.Duplicate returns something other
' than a ChartObject.
Set newChartObj = chartObj.Duplicate.Chart.Parent
newChartObj.Top = chartObj.Top
newChartObj.Left = chartObj.Left
newChartObj.Chart.Location xlLocationAsObject, destChartSheet.Name
For Each chSeries In newChartObj.Chart.SeriesCollection
chSeries.FormulaR1C1 = Replace(chSeries.FormulaR1C1, DataSheetName1, DataSheetName2)
Next
Next chartObj
End Sub
This works (and fails) differently from the first solution: it also copies the charts into the target worksheet, and unlike the earlier example it is possible to delete those charts using that Delete_Charts
subroutine.
Unfortunately, this code fails at:
For Each chSeries In newChartObj.Chart.SeriesCollection
And the error is again "Run-time error '1004': Application-defined or object-defined error".
In fact, attempting to inspect newChartObj
with the debugger at that point simply crashes Excel.
So, I have two partial solutions, both of which seem to be failing in ways that don't match the examples or documentation I have seen elsewhere. I would appreciate any help in getting either one of these to work.
I think when the chart location is moved that is changing the reference to the chart object, causing the Series Collection to fail.
I was able to reproduce the issue, and the below code does work, however I'm on PC so I'm not 100% if any further changes would be needed to get up and running on Mac. If you move this line:
newChartObj.Chart.Location xlLocationAsObject, destChartSheet.Name
after the SeriesCollection
loop it works, but not before.
Option Explicit
Sub Copy_Charts()
Dim DataSheetName1 As String, DataSheetName2 As String
Dim sourceChartSheet As Worksheet, destChartSheet As Worksheet
Dim chartObj As ChartObject, newChartObj As ChartObject
Dim chartObjCopy As ChartObject
Dim chSeries As Series
DataSheetName1 = "CU-2"
DataSheetName2 = "CU-8"
Set sourceChartSheet = ThisWorkbook.Sheets(DataSheetName1)
Set destChartSheet = ThisWorkbook.Sheets(DataSheetName2)
For Each chartObj In sourceChartSheet.ChartObjects
Set newChartObj = chartObj.Duplicate.Chart.Parent
'Set newChartObj = chartObj 'Reference the sheet, good if you are cut/pasting the chart
For Each chSeries In newChartObj.Chart.SeriesCollection
chSeries.FormulaR1C1 = Replace(chSeries.FormulaR1C1, DataSheetName1, DataSheetName2)
Next
newChartObj.Top = chartObj.Top
newChartObj.Left = chartObj.Left
'Move this after the SeriesCollection loop
newChartObj.Chart.Location xlLocationAsObject, destChartSheet.Name
Next
End Sub
Sub Copy_Charts()
Dim DataSheetName1 As String, DataSheetName2 As String
Dim sourceChartSheet As Worksheet, destChartSheet As Worksheet
Dim chartObj As ChartObject, newChartObj As ChartObject
Dim chartObjCopy As ChartObject
Dim chSeries As Series
Dim chartIndex As Integer
DataSheetName1 = "CU-2"
DataSheetName2 = "CU-8"
Set sourceChartSheet = Sheets("CU-2")
Set destChartSheet = Sheets("CU-8")
For Each chartObj In sourceChartSheet.ChartObjects
' No idea why chartObj.Duplicate returns something other
' than a ChartObject.
Set newChartObj = chartObj.Duplicate.Chart.Parent
newChartObj.Top = chartObj.Top
newChartObj.Left = chartObj.Left
newChartObj.Chart.Location xlLocationAsObject, destChartSheet.Name
'For Each chSeries In newChartObj.Chart.SeriesCollection
' chSeries.FormulaR1C1 = Replace(chSeries.FormulaR1C1, DataSheetName1, DataSheetName2)
'Next
Next chartObj
For Each chartObj In destChartSheet.ChartObjects
For Each chSeries In chartObj.Chart.SeriesCollection:
chSeries.FormulaR1C1 = Replace(chSeries.FormulaR1C1, DataSheetName1, DataSheetName2)
Next
Next chartObj
End Sub
I tested it on my Mac, Excel: 16.20 and it works. It's just a slight change on your original code.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With