Excel VBAでパワーポイントを保存して閉じる

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

私はちょうどパワーポイントのインスタンスを開き、その下に試験し、それが見えるように、プレゼンテーションを作成し、（パスを変更する必要があります）プレゼンテーションを保存し、アプリケーションを終了し、変数を排出します。これがあなたのニーズに合わない場合は、私にお知らせください。

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