通过 Excel VBA 保存并关闭 powerpoint

Question

下面是根据定义的名称创建多个图表的代码，然后使用这些定义的名称打开 powerpoint 文件并在图表中转储。除了最后一部分，我一切正常：保存并关闭文件。

我已将尝试保存和关闭文件的尝试标记为绿色。任何帮助表示赞赏！

Sub Slide19()
Dim rngx As Range
Dim rngy As Range
Dim rngz As Range

Dim ws As Worksheet
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim icnt As Long
Dim lastrow As Long
Dim k As Long
Dim icounter As Long
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Variant
Dim Chart As ChartObject
Dim PPapp As Object
Dim PPTDoc As PowerPoint.Presentation
Dim PPT As PowerPoint.Application
Dim PPpres As Object
Dim pptSlide As PowerPoint.Slide
Dim ppslide As Object

Dim filename As String
Dim filename2 As String

Set ws = Worksheets("Reference")
Set ws1 = Worksheets("Levels")
Set ws2 = Worksheets("Slide 19")

ws2.Activate
ws2.Range("e:f").NumberFormat = "0%"
lastrow = ws2.Cells(Rows.Count, "b").End(xlUp).Row
For icounter = 1 To lastrow
For icnt = 14 To 20
If ws2.Cells(icounter, 2) = ws.Cells(icnt, 3) Then

'd = ws.Cells(icnt, 3)
a = icounter + 1
b = icounter + 2
c = icounter + 12
filename = "filepath" & ws2.Cells(icounter, 2) & ".pptx"
filename2 = "xxyyxx" & ws2.Cells(icounter, 2)

'create RBI Vs LTM
Set rngx = Range(Cells(a, 4), Cells(c, 4))
        Set rngy = Range(Cells(a, 5), Cells(c, 6))

            ws2.Shapes.AddChart.Select
          ' ActiveChart.Name = ws2.Cells(icounter, 2) & "Slide8"
            ActiveChart.ChartType = xlColumnClustered
            ActiveChart.SetSourceData Source:=Union(rngx, rngy), PlotBy:=xlColumns

            With ActiveChart
            '.Name = d & "Slide8"
            .SetElement (msoElementChartTitleAboveChart)
            .ChartGroups(1).Overlap = 0
            .Legend.Delete
            .ChartTitle.Select
            .ChartTitle.Text = "Engagement by Level"
            .SeriesCollection(1).ApplyDataLabels
            .SeriesCollection(2).ApplyDataLabels

            .SeriesCollection(1).Interior.Color = RGB(0, 101, 179)
            .SeriesCollection(2).Interior.Color = RGB(192, 80, 77)
            .Axes(xlValue).MaximumScale = 1
           ' .Axes(xlValue).MinimumScale = 0.5
            '.Height = 374.4
            '.Width = 712.8

            .Axes(xlValue).TickLabels.NumberFormat = "0%"
            .SetElement (msoElementLegendRight)
            End With

            ActiveChart.Axes(xlValue).MajorGridlines.Select
            Selection.Format.Line.Visible = msoFalse
            ActiveChart.Legend.Select
            Selection.Left = 466.71
            Selection.Top = 12.467


            Set rngx = Nothing
            Set rngy = Nothing


With ActiveChart.Parent
.Height = Application.InchesToPoints(5.2)
.Width = Application.InchesToPoints(9.9)
End With

Set PPapp = CreateObject("Powerpoint.Application")

Set PPT = New PowerPoint.Application
PPT.Presentations.Open filename:=filename

PPapp.ActiveWindow.View.GotoSlide Index:=9


ActiveChart.ChartArea.Copy
PPapp.ActiveWindow.Panes(1).Activate
PPapp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
'PPT.ActivePresentation.SaveAs filename
'PPT.Presentations(filename2).Close
'PPapp.Quit


'PPT.Presentations.Close
End If
'PPapp.Quit
Next icnt
Next icounter
'PPapp.Quit



End Sub

Answer 1

您保存和关闭演示文稿的代码应该可以正常工作。唯一应该做的就是在保存和关闭之间放置等待功能，因为关闭行不会“等待”保存导致错误。

PPT.ActivePresentation.SaveAs filename
waiting(7) 'For my usage 7 seconds waiting is enough - it depends on size of your presentation
PPT.Presentations(filename2).Close

等待功能：

Sub waiting(tsecs As Single)
Dim sngsec As Single

sngsec = Timer + tsecs
Do While Timer < sngsec
    DoEvents
Loop

End Sub

然后你可以使用：

PPT.Quit
set PPT = Nothing

Answer 2

我刚刚测试了以下内容，它打开了一个 Powerpoint 实例，使其可见，创建演示文稿，保存演示文稿（需要更改路径），退出应用程序并释放变量。如果这不符合您的需求，请告诉我。

Sub ppt()
Dim ppt As New PowerPoint.Application
Dim pres As PowerPoint.Presentation
ppt.Visible = True
Set pres = ppt.Presentations.Add
pres.SaveAs "C:\Users\xxx\Desktop\ppttest.pptx"
pres.Close
ppt.Quit
Set ppt = Nothing
End Sub