仅将图像复制到新的工作簿

我已经正确创build了代码，将从当前工作簿（main）中复制工作表并将其粘贴到新的工作簿（wbnew）中。 该粘贴只会做值，以防止公式转移。 我想在图表上使用“直方图”。 您可以复制graphics，并将其粘贴为图片。 我怎样才能做到这一点与多张图表呢？

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