将Excel图表作为图片导出到PowerPoint

Question

我在excel工作簿中有一张图表和多张图表，我正试图将所有图表作为图片导出到PowerPoints中问题是我当前的代码不起作用我的代码错误：

1. PowerPoint按预期打开

2. 我在运行前选择的活动工作表的图表是复制

3. 复制的图表粘贴在PowerPoint 中

4. PowerPoint创建下一个幻灯片

5. 现在，同一张纸上的同一张图表再次复制！我希望代码移动到下一张工作表，选择上面的图表，并在下一张幻灯片中复制过去！

   Sub TEST_ExportChartsToPowerPoint_SingleWorkbook(('声明PowerPoint对象变量将pptApp设为PowerPoint。应用Dim ppt打印为PowerPoint。演示调暗ppt滑动为PowerPoint。滑动将SldIndex标注为整数'声明Excel对象变量将Chrt分帐为图表对象'按图表区域调暗ChrtDim WrkSht As Worksheet

   'Create a new instance of PowerPoint
   Set pptApp = New PowerPoint.Application
   pptApp.Visible = True
   'Create a new Presentation within the PowerPoint Application
   Set pptPres = pptApp.Presentations.Add
   'Create an index handler for the slide creation
   SldIndex = 1
   'Loop through all of the worksheets in the active work book
   For Each WrkSht In Worksheets
   'WrkSht.Select
   ActiveChart.ChartArea.Select
   ActiveChart.ChartArea.Copy
   'Create a new slide, set the layout to blank, and paste the chart on the slide
   Set pptSlide = pptPres.Slides.Add(SldIndex, ppLayoutBlank)
   pptSlide.Shapes.Paste
   'Increment our slide index
   SldIndex = SldIndex + 1
   Next WrkSht
   

   结束子

Answer 1

问题在于如何引用图表。看看你的循环：

'Loop through all of the worksheets in the active work book
For Each WrkSht In Worksheets
'WrkSht.Select

ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy

'Create a new slide, set the layout to blank, and paste the chart on the slide
Set pptSlide = pptPres.Slides.Add(SldIndex, ppLayoutBlank)
pptSlide.Shapes.Paste

'Increment our slide index
SldIndex = SldIndex + 1

Next WrkSht

即使循环遍历所有Worksheets，也只能引用ActiveChart。你需要在循环中参考工作表上的图表。默认情况下，ActiveChart引用活动工作表上的图表。这就是为什么为每张幻灯片复制相同的图表，因为引用永远不会改变。因此，您需要在循环中更改对当前图纸的引用。

更改以下行

ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy

至

WrkSht.ChartObjects(1).Chart.ChartArea.Copy

此代码正确地引用了图表。还要注意，您不需要使用ChartArea的.Select方法。