Saving a copy of an updated PowerPoint through VBA

Lewisc_97

New Member
Joined
Feb 25, 2019
Messages
4
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
 

Forum statistics

Threads
1,078,442
Messages
5,340,305
Members
399,366
Latest member
ahmed elsaid

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top