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

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

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

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

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

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