时间戳

首页 > 解决方案 > 使用 VBA 复制图表：无法删除或无法修改副本

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

问题描述

我在 MacOS 上使用 Excel。“关于”信息告诉我它是 16.16.5 版本，显然对应于 Office 2016。如果您查看此处的代码并认为“嘿，这对我有用”，如果您可以发表评论，那就太好了包括您正在使用的 Excel 版本。

我有一个电子表格，我想将图表从“模板”工作表复制到大约。80 个其他工作表，然后修改它们以引用目标工作表上的数据而不是原始工作表（通过系列上的简单搜索和替换）。

乍一看，这似乎并不难，在 Stack Overflow 和其他地方都有很多潜在的解决方案，但我似乎一直遇到意想不到的行为。

对于下面的示例，代码只是将图表从一个工作表复制到另一个工作表，而不是遍历所有可用的工作表，因为这样可以在失败时更轻松地进行清理。到目前为止，始终如此。

尝试#1

我的第一次尝试是这样的：

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

这几乎可行：它实际上将图表复制到目标工作表。但是，它在这一行失败了：

        Set chartObjCopy = destChartSheet.ChartObjects(chartIndex)

错误是“运行时错误'1004'：应用程序定义的或对象定义的错误”。

事实上，如果您此时查看 destChartSheet.ChartObjects.Count，它仍然显示为0. 此外，如果您尝试使用以下代码删除图表：

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

它实际上不会删除图表。如果您手动复制和粘贴图表，相同的删除代码也可以正常工作。

总之：这段代码确实复制了图表，但我无法获得对副本的引用来修改它，也不能删除它。

尝试#2

我决定将复制粘贴扔出窗口并尝试使用该Duplicate方法。我最终得到以下结果：

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

这与第一个解决方案的工作方式（并且失败）不同：它还将图表复制到目标工作表中，并且与前面的示例不同，可以使用该Delete_Charts子例程删除这些图表。

不幸的是，此代码在以下位置失败：

        For Each chSeries In newChartObj.Chart.SeriesCollection

并且错误再次是“运行时错误'1004'：应用程序定义的或对象定义的错误”。

实际上，newChartObj此时尝试使用调试器进行检查只会使 Excel 崩溃。

因此，我有两个部分解决方案，这两个解决方案似乎都以与我在其他地方看到的示例或文档不匹配的方式失败。我将不胜感激任何帮助使其中任何一个工作。

标签： excelvbamacos

解决方案

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

我能够重现该问题，并且下面的代码确实有效，但是我在 PC 上，所以如果需要任何进一步的更改才能在 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

推荐阅读