I have a weekly presentation that I'm trying to automate. Each week I delete all of the previous weeks contents and paste in the new data using a macro in excel. However I cannot figure out how to delete all of the previous contents. Note: I do not want to delete the slides, just the pictures that are on the slides.
Edited: Below is the code I use in excel to paste in the new data each week. This code is for a single slide. Is it possible to add code to delete the previous weeks data before pasting in the new data?
Sub PasteAltSummaryToDeck()
'PURPOSE: Copy alt summary page and paste into weekly deck'
Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then Exit
If PowerPointApp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Make PowerPoint Visible and Active
PowerPointApp.ActiveWindow.Panes(2).Activate
'Create a New Presentation
Set myPresentation = PowerPointApp.ActivePresentation
'List of PPT Slides to Paste to
MySlideArray = Array(11)
'List of Excel Ranges to Copy from
MyRangeArray = Array(Sheet2.Range("F5:AS60"))
'Loop through Array data
For x = LBound(MySlideArray) To UBound(MySlideArray)
'Copy Excel Range
MyRangeArray(x).Copy
'Paste to PowerPoint and position
On Error Resume Next
Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
On Error GoTo 0
'Center Object
With myPresentation.PageSetup
shp.Left = (.SlideWidth \ 2) - (shp.Width \ 2)
shp.Top = (.SlideHeight \ 2) - (shp.Height \ 2)
End With
Next x
'Record the date & time of procedure execution
Range("ExportAltSumToPPT").Value = Format(Now(), "mm/dd/yy") & " - " &
Format(TimeValue(Now), "hh:mm AM/PM")
'Transfer Complete
Application.CutCopyMode = False
ThisWorkbook.Activate
MsgBox "Complete!"
End Sub
try this;
Sub deletepics()
'variables
Dim slide As slide
Dim y As Long
'loop through slides backwards and with the slides shapes if they are pictures then delete
For Each slide In ActivePresentation.Slides
For y = slide.Shapes.Count To 1 Step -1
With slide.Shapes(y)
If .Type = msoPicture Then
.Delete
End If
End With
Next
Next
End Sub
EDIT:If you want to delete images on only slides 14 to 2 you can do this. Ignore my comments they were wrong. But the below code will work for you.
Sub deletepics()
'variables
Dim slide As slide
Dim y As Long
'loop through slides backwards and with the slides shapes if they are pictures then delete
For y = ActivePresentation.Slides.Count To 2 Step -1
If y <> 14 Then
Set sldTemp = ActivePresentation.Slides(y)
For lngCount = sldTemp.Shapes.Count To 1 Step -1
With sldTemp.Shapes(lngCount)
If .Type = msoPicture Then
.Delete
End If
End With
Next
End If
Next
End Sub