Saving a copy of an updated PowerPoint through VBA

[Lewisc_97]

Hi People,

I have created a script that pastes charts to an existing Powerpoint, however I want the Powerpoint to Save As so I have a new copy. I don't know where to start with this... I have copied my code below. Hopefully this makes sense

Thanks for the help

Lewis

Sub TransferCharts2()
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim excelChart As ChartObject
Dim presChart As Object
Dim WS_Count As Integer
Dim I As Integer
Dim Title As String
Dim tb As PowerPoint.Shape



Set PowerPointApp = New PowerPoint.Application

Set myPresentation = PowerPointApp.Presentations.Open("P:\Lewis & Jacob\Lewis\Top Level Automation\Master Powerpoint.pptx")

Application.ScreenUpdating = False

Worksheets(1).Select
Title = Range("C5")
Set mySlide = myPresentation.Slides(1)
Set tb = mySlide.Shapes("Text Placeholder 3")
tb.TextFrame2.TextRange.Characters.Text = Title

WS_Count = ActiveWorkbook.Sheets.Count

For I = 2 To WS_Count
If I < 6 Then
Set mySlide = myPresentation.Slides(I)
' Add Commentary
Worksheets(I).Select

For Each excelChart In ActiveSheet.ChartObjects

excelChart.Chart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)

'excelChart.Chart.Axes(xlCategory).TickLabels.Font.Color = RGB(0, 0, 0)

'excelChart.Chart.Axes(xlValue, xlPrimary).TickLabels.Font.Color = RGB(0, 0, 0)

'excelChart.Chart.Axes(xlValue, xlPrimary).AxisTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)

'excelChart.Chart.Axes(xlValue, xlSecondary).TickLabels.Font.Color = RGB(0, 0, 0)

'excelChart.Chart.Axes(xlValue, xlSecondary).AxisTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)

excelChart.Chart.Legend.Font.Color = RGB(0, 0, 0)


excelChart.Copy

mySlide.Shapes.PasteSpecial (ppPasteDeviceIndependentBitmap)

With mySlide
With .Shapes(.Shapes.Count)
.LockAspectRatio = msoTrue
.Left = 9
.Top = 60
.Height = 400
.Width = 700
End With
End With
Next
End If
Next I

PowerPointApp.Visible = True
PowerPointApp.Activate

Application.CutCopyMode = False



End Sub