Я использую Excel на MacOS. Информация «О программе» говорит мне, что это версия 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.
Итак, у меня есть два частичных решения, оба из которых, похоже, дают сбой таким образом, что не соответствуют примерам или документации, которые я видел в других местах. Я был бы признателен за любую помощь, чтобы заставить любой из них работать.