Блог

Я пишу некоторый код VBA, который скопирует диаграмму с каждого листа в моей рабочей книге, а затем вставит объединенную диаграмму на новый лист.

Я знаю, что могу скопировать каждую диаграмму вручную, а затем вставить поверх предыдущей диаграммы, где каждый набор данных будет доступен. Однако это болезненно выполняется вручную. Я хочу создать макрос VBA для этого вместо этого.

В настоящее время мой код копирует и вставляет диаграмму с каждого листа на новый лист, но они по-прежнему являются отдельными диаграммами. Мне нужно некоторое руководство.

 Sub copyGraphs()
Dim OutSht As Worksheet
Dim Chart As ChartObject
Dim PlaceInRange As Range

Set OutputSheet = ActiveWorkbook.Sheets("PostProcess")
Set PlaceInRange = OutputSheet.Range("A1:J21")

'Loop charts
For Each Sheet In Worksheets
    Sheet.Activate
    
    If Range("A4") <> "" Then
        'Copy/paste charts
        ActiveSheet.ChartObjects("Chart 1").Activate
        ActiveChart.ChartArea.Copy
        Sheet.ChartObjects("Chart 1").Copy
        OutputSheet.Paste PlaceInRange
    End If
Next Sheet
End Sub
  

Любые предложения будут высоко оценены.

Редактировать:

В итоге мне пришлось запускать цикл для каждого графика. По-прежнему требуется вручную убедиться, что «Диаграмма 1», «Диаграмма x» находятся на главном листе с именем PostProcess в моем коде. Для меня это довольно грубая сила, но это работает.

 Sub copyGraphs()
Dim OutSht As Worksheet
Dim Chart As ChartObject
Dim PlaceInRange As Range
Dim chartInput As Chart
Dim chartOutput As Chart

Set Outputsheet = ActiveWorkbook.Sheets("PostProcess") '<~~ Output sheet


'Loop charts for efficiency
For Each Sheet In Worksheets
    Sheet.Activate
    
    If Range("A4") <> "" Then
        'Copy/paste charts
        ActiveSheet.ChartObjects("Chart 1").Activate
        ActiveChart.ChartArea.Copy
        
        Sheets("PostProcess").Select
        ActiveSheet.ChartObjects("Chart 1").Activate
        ActiveChart.Paste


    End If
Next Sheet
  

Если я правильно понимаю ваш вопрос, вы должны вставить свои входные диаграммы непосредственно в объединенную диаграмму, а не в указанный диапазон. Вы должны использовать что-то вроде:

 Dim chartInput As Chart
Dim chartOutput As Chart
Set chartInput = Sheet1.ChartObjects("Chart 1").Chart
Set chartOutput = Sheet1.ChartObjects("Combined chart").Chart

chartInput.ChartArea.Copy
chartOutput.Paste