Question

我在Excel文件中有31个图形，需要将它们导出到自己的单独的PowerPoint文件中，然后应保存随后的31个PowerPoint演示文稿。

运行下面的代码，所有图形都成功导出到单个演示文稿中；但是，只有第二个演示文稿（PowerPoint1，PowerPoint3，PowerPoint5等）被保存为文件到我的计算机中。知道为什么吗？

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

任何指导表示赞赏。

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演示文稿

2 个答案: