Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Copying charts with VBA: Either can't delete or can't modify the copies

Tags:

macos

excel

vba

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.

Attempt #1

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.

Attempt #2

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.

like image 257
larsks Avatar asked Dec 13 '22 13:12

larsks


2 Answers

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
like image 53
Ryan Wildry Avatar answered Dec 16 '22 03:12

Ryan Wildry


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.

like image 36
xudesheng Avatar answered Dec 16 '22 01:12

xudesheng