Question

我是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个图表。但我有几个问题。

当我要求

时

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

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

当我取消注释时

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

我收到以下错误：

编译错误：找不到方法或数据成员

有时候这一行：

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

获取以下错误：

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

但XX存在，而且是“FyV”

我试过了

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

和

'Hoja8.ChartObjects(15).Select

要解决1和3，但它什么都没改变。

提前致谢， Bauti。

Answer 1

我找到了一个解决方案（由答案指导，谢谢！）它不是那么优雅，但它确实有效。

  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)代表工作表上的“第十五”图表 - 15不一定对应于图表的名称，也不一定对应于工作表上的位置，但与订单相关其中创建了图表。

Answer 3

当我取消注释时

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

编译错误：找不到方法或数据成员

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

如果您需要设置范围内多个形状的大小，则必须遍历ShapeRange集合：

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

顺便说一句，您通常希望避免在PPT或Excel中选择任何内容。获取对图表的对象引用而不是选择它。实际上，如果图表所在的工作表当前不在视图中，则尝试选择它可能是您看到的错误的一个原因。

使用VBA从Excel创建PPT的问题

3 个答案: