VBA 仅保存每秒打开的 PowerPoint 演示文稿

Question

我在一个 Excel 文件中有 31 个图表，需要将其导出到各自的 PowerPoint 文件中，然后应保存后续的 31 个 PowerPoint 演示文稿。

运行下面的代码，所有的图都成功导出到单独的presentations；但是，只有每隔一个演示文稿（PowerPoint1、PowerPoint3、PowerPoint5 等）会在我的机器上保存为一个文件。知道为什么吗？

注意：'path' 变量是在代码的前面定义的，当时用户可以选择 select 他们自己的路径。

感谢任何指导。

Const ppLayoutBlank = 2
Const ppViewSlide = 1
Const ppFixedFormatTypePDF As Long = 2
Const ppPrintSelection As Long = 2
Option Explicit

Sub ExportChartstoPowerPoint()

'
' Code to allow user to choose path goes here
'

Dim chr
For Each chr In Sheets("My Excel File").ChartObjects
    Dim PPApp As Object
    Set PPApp = CreateObject("PowerPoint.Application")
    PPApp.Presentations.Add
    PPApp.ActiveWindow.ViewType = ppViewSlide
    PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
    PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count
    chr.Select
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
    PPApp.ActiveWindow.View.Paste
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
Next chr
PPApp.Visible = True

Dim CurOpenPresentation As Object
Dim PPProgram As Object
Set PPProgram = GetObject(, "PowerPoint.Application")
For Each CurOpenPresentation In PPProgram.Presentations
      CurOpenPresentation.SaveAs path & "\" & CurOpenPresentation.FullName & ".pptx"
      Application.Wait (Now + #12:00:03 AM#) ' Wait 3 seconds to allow the computer time to save the file before it closes it
      CurOpenPresentation.Close
Next CurOpenPresentation


End Sub

Answer 1

您已经将 PPApp 作为 PowerPoint 应用程序对象 - 继续使用它并删除定义 PPProgram 的行。

此外，为要添加的演示文稿声明并实例化一个对象：

Dim PPPres as Object
Set PPPres = PPApp.Presentations.Add

之后，使用PPPres处理演示文稿

PPPres.Slides.Add PPPres.Slides.Count + 1, ppLayoutBlank
PPApp.ActiveWindow.View.GotoSlide PPPres.Slides.Count

这也意味着不需要循环来保存和关闭演示文稿

 PPPres.SaveAs path & "\" & PPPres.FullName & ".pptx"
 Application.Wait (Now + #12:00:03 AM#) ' Wait 3 seconds to allow the computer time to save the file before it closes it
 PPPres.Close

在End Sub之前显式释放这些对象也是一个好主意：

Set PPPres = Nothing
Set PPApp = Nothing

如果您想始终对每个演示文稿使用 CreateObject，则代码还应 Quit PowerPoint 应用程序在之前将其设置为 Nothing。或者，代码可以使用 GetObject 检查 PowerPoint 是否存在，只有当它不是运行时才使用 CreateObject 来启动它。有很多代码示例展示了如何做到这一点。

Answer 2

让我进一步解释一下原来的问题：

假设您有 30 个打开的 PowerPoint 演示文稿。您启动一个 For 循环来遍历所有 30 个。在第一次迭代中，您的 CurOpenPresentation（您的 30 个集合中的第一个项目）是 PowerPoint1。您将其保存到一个位置并关闭它。

现在您已经收集了 29 个打开的 PowerPoint 演示文稿，并且您的 CurOpenPresentation 现在是 PowerPoint2，因为 PowerPoint1 不再存在于范围内，因为您已经关闭它。现在您点击 Next CurOpenPresentation 行并从 PowerPoint2 移动到 PowerPoint3 而无需保存 PowerPoint2。

这就是为什么您只节省 1、3、5 等 :)

VBA 仅保存每秒打开的 PowerPoint 演示文稿

VBA is only saving every second open PowerPoint presentation

excel

powerpoint

vba