使用VBA复制图表:无法删除或无法修改副本

我认为,当移动图表位置时,会更改对图表对象的引用,从而导致序列集合失败。

我能够重现这个问题,下面的代码确实有效,但是我在个人电脑上,所以如果需要任何进一步的更改来启动和运行Mac,我不是100%。如果移动此行:

newChartObj.Chart.Location xlLocationAsObject, destChartSheet.Name

后 SeriesCollection 循环它工作,但不是以前。

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

我在我的Mac,Excel:16.20上测试了它,它工作了。这只是你原始代码的一个微小变化。

我没有访问Mac的权限,所以我必须在Windows10,Office2016上测试它,但我可以复制错误。 关于您的尝试2,我发现问题是由以下行引起的:

newChartObj.Chart.Location xlLocationAsObject, destChartSheet.Name

它有一个副作用:将创建一个新图表,而原始对象(引用)将变为无效,因此当您尝试访问其SerieScollection属性时,将收到一个错误。但是,location函数返回对新图表的引用,因此您只需更新newchartobj以引用新图表(而不是在代码中使用上面的行):

Set newChartObj = newChartObj.Chart.Location(xlLocationAsObject, destChartSheet.Name).Parent

尝试

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.Paste
          '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