Question

我已正确创建代码，它将从当前工作簿（main）复制工作表并将其粘贴到新工作簿（wbnew）中。粘贴仅用于防止公式传输。我想对名为“histograms”的工作表上的图表做同样的事情。您可以复制图形，并将其粘贴为图片。如何使用包含多个图表的工作表来完成此操作？

        Main.Worksheets("MyData").Copy Before:=wbnew.Sheets(1)
With wbnew.Sheets(1).UsedRange
    .value = .value 'converts formulas to values
End With


        Main.Worksheets("Histograms").Copy Before:=wbnew.Sheets(1)
With wbnew.Sheets(1).UsedRange
    .Pictures = .Pictures 'converts graphs to pictures
End With

Answer 1

您需要使用chartobjects集合，遍历数据表中的每个图表并将其作为图片粘贴到图片工作表中：

Sub CopyChartsToPics()
Dim oChart As ChartObject

    ActiveWorkbook.Worksheets("charts").Activate

    For Each oChart In ActiveSheet.ChartObjects
        oChart.Select
        oChart.Copy
        ActiveWorkbook.Worksheets("pictures").Select
        ActiveWorkbook.Worksheets("pictures").Pictures.Paste
        ActiveWorkbook.Worksheets("charts").Activate
    Next
End Sub

仅将图像复制到新工作簿

1 个答案: