使用VBA从Excel创buildPPT的问题

我对VBA相当陌生，我正在尝试从工作簿中进行一个powepoint演示。 我有一个模板，想法是用图表和图表来填充。

这是我的代码：

Sub ChartToPresentation() ' Set a VBE reference to Microsoft PowerPoint Object Library Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide ' Reference existing instance of PowerPoint Set PPApp = GetObject(, "Powerpoint.Application") ' Reference active presentation Set PPPres = PPApp.ActivePresentation PPApp.ActiveWindow.ViewType = ppViewSlide ' 6 - Convocatoria - Presentismo Set PPSlide = PPPres.Slides(6) ThisWorkbook.Worksheets("FyV").ChartObjects(15).Select 'Hoja8.ChartObjects(15).Select ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture PPSlide.Shapes.Paste PPApp.ActiveWindow.Selection.ShapeRange.Left = 10 PPApp.ActiveWindow.Selection.ShapeRange.Top = 20 'PPSlide.ShapeRange.Width = 80 'PPSlide.ShapeRange.Height = 80 End Sub 

我有一个图块，有时每个幻灯片超过1个图块。 但是我有几个问题。

1. 当我问

     ThisWorkbook.Worksheets("FyV").ChartObjects(15).Select 

我从该工作表中得到图表24。 当我要求图表3，12和13时，我得到了图表5。

2. 当我取消注释

    'PPSlide.ShapeRange.Width = 80 'PPSlide.ShapeRange.Height = 80 

我得到以下错误：

编译错误：未find方法或数据成员

3. 有时候这行：

    ThisWorkbook.Worksheets("FyV").ChartObjects(XX).Select 

获取以下错误：

运行时错误“1004”：应用程序定义或对象定义的错误

但XX存在，它是在“FyV”

我努力了

  ThisWorkbook.Worksheets("FyV").ChartObjects(15).Select 

和

 'Hoja8.ChartObjects(15).Select 

解决1和3，但它没有改变。

在此先感谢Bauti。

Answer 1

我find了一个解决scheme（由答案引导，谢谢！）这不是那么优雅，但它的工作原理。

  Sub ChartToPresentation() ' Set a VBE reference to Microsoft PowerPoint Object Library Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide ' Reference existing instance of PowerPoint Set PPApp = GetObject(, "Powerpoint.Application") ' Reference active presentation Set PPPres = PPApp.ActivePresentation PPApp.ActiveWindow.ViewType = ppViewSlide Worksheets("FyV").Select ' 6 - Convocatoria - Presentismo Set PPSlide = PPPres.Slides(6) ThisWorkbook.Worksheets("FyV").ChartObjects("Chart 15").Select 'Hoja8.ChartObjects(15).Select ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture PPSlide.Shapes.Paste PPApp.ActiveWindow.Selection.ShapeRange.Left = 40 PPApp.ActiveWindow.Selection.ShapeRange.Top = 200 PPApp.ActiveWindow.Selection.ShapeRange.Width = 160 PPApp.ActiveWindow.Selection.ShapeRange.Height = 160 End Sub 

由于几乎没有工作表的变化，所以每次改变时都不需要添加工作表行。

此外，问在Excel论坛我得到了这个答案，似乎工作：

 Sub ChartToPresentation() ' Set a VBE reference to Microsoft PowerPoint Object Library Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Dim oShape As PowerPoint.Shape ' Reference existing instance of PowerPoint Set PPApp = GetObject(, "Powerpoint.Application") ' Reference active presentation Set PPPres = PPApp.ActivePresentation PPApp.ActiveWindow.ViewType = ppViewSlide ' 6 - Convocatoria - Presentismo Set PPSlide = PPPres.Slides(6) ThisWorkbook.Worksheets("FyV").ChartObjects("Chart 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture PPSlide.Shapes.Paste With PPSlide Set oShape = .Shapes(.Shapes.Count) End With 'oShape.LockAspectRatio = msoFalse oShape.Left = 10 oShape.Top = 20 oShape.Width = 80 oShape.Height = 80 End Sub 

谢谢你的回复，Bauti。

Answer 2

ChartObjects(15)代表图表上的“ 十五 ”图表ChartObjects(15)并不一定对应于图表的名称或图表上的位置，但与图表的创build顺序有关。

Answer 3

当我取消注释

'PPSlide.ShapeRange.Width = 80'PPSlide.ShapeRange.Height = 80我得到以下错误：

编译错误：未find方法或数据成员

---

是的，因为您无法设置形状范围的宽度和高度。
如果范围中只有一个形状，就像从Excel中粘贴到PPT的图表一样，则可以使用PPSlide.ShapeRange（1）.Height等。

如果你需要在一个范围内设置多个形状的大小，你必须迭代ShapeRange集合：

 For x = 1 to PPSlide.ShapeRange.Count With PPSlide.ShapeRange(x) ' Do stuff here End With Next 

顺便说一下，你通常要避免select任何东西，在PPT或Excel中。 获取对图表的对象引用，而不是select它。 事实上，如果图表所在的图表当前不在视图中，则尝试select该图表可能是您所看到的错误的一个原因。