使用 VBA 从 excel 创建 PPT 时出现问题

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

我每张图有一个块，有时每张幻灯片有不止一张图。但是我有几个问题。

当我要求

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

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

当我取消注释时

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

我收到以下错误：

Compile error: Method or data member not found

有时行：

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

出现以下错误：

Run-time error '1004': Application-defined or object-defined error

但是XX存在，并且在"FyV"

我试过了

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

和

'Hoja8.ChartObjects(15).Select

解决了 1 和 3，但没有任何改变。

提前致谢，包蒂

Answer 1

ChartObjects(15) 表示 sheet 上的“第十五”图表 - 15 不一定对应于图表名称或其在sheet，但与图表的创建顺序有关。

Answer 2

当我取消评论时

'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 中选择任何内容。获取对图表的对象引用而不是选择它。事实上，如果 sheet 图表当前不在视图中，请尝试。Select 这可能是您看到错误的原因之一。

Answer 3

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

  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

感谢您的回复，包蒂.

使用 VBA 从 excel 创建 PPT 时出现问题

Problems using VBA to create a PPT from an excel

excel

powerpoint

vba