Excel VBA复制多个工作表中的图表，然后将它们合并到单独工作表中的单个图形中

问题描述

我正在编写一些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

任何建议将不胜感激。

编辑：

我最终不得不为每个图运行一个循环。仍然需要手动确保“ Chart 1”，“ Chart 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

excel excel graph