title: Save & Close powerpoint through Excel VBA
body: <p>Below is code that creates multiple charts based on defined names, then opens powerpoint files with those defined names and dumps in the charts. I have everything working except the last part: save and close the file. </p>
  
  <p>I've marked in green my attempts at trying to save and close the files. Any help is appreciated!</p>
  
  <pre><code>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" &amp; ws2.Cells(icounter, 2) &amp; ".pptx"
  filename2 = "xxyyxx" &amp; 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) &amp; "Slide8"
              ActiveChart.ChartType = xlColumnClustered
              ActiveChart.SetSourceData Source:=Union(rngx, rngy), PlotBy:=xlColumns
  
              With ActiveChart
              '.Name = d &amp; "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
  </code></pre>