PPT VBA MACROS HELP (1)Delete all empty placeholders (2)Automate duplicate and delete

[ZoeZoe]

Hi there!
I am very new to VBA and macros, but really loving the time these have been saving me!!! My curiosity is peaked.
I have searched a lot for specific VBA's to do a few things but haven't found quite what I'm looking for, basically I am using powerpoint to create photography related things (easy to export slides as jpg or video).
I'd love a hand creating these two macros if anyone would like to help : pray2:

Macro (1) removes all empty image placeholders from a slide (or entire presentation)
why I need this: one of the files I've made starts with like 200 image placeholders that are stacked on each other (scattered). I drag and drop all the images I want to use into this one slide, but there could be just 90 images so I need to delete all the remaining empty image placeholders

Macro (2) Duplicates the active slide, goes back to 1st slide, deletes the image + image placeholder and repeats until there are no more images/placeholders
why I need this: working backwards (from having ALL images) I am removing one stacked image at a time so the starting slide shows only the bottom image. I save this out as a video so it looks like the pictures are stacking up on top of each other.

Here is a screenshot of my process to help explain this
https://drive.google.com/file/d/1YzAYVtGGYaqGE5mNVsEnQKQuWWLtDAce/view?usp=share_link

and here is what the final ppt looks like in slide sorter
https://drive.google.com/file/d/1FKF8VBAKa0xz_cgfd8Cc1rvkgZWqLSxi/view?usp=share_link

I would be super grateful if someone could generously help automate this for me :bow:
happy to buy you a coffee(s) or compensate, as this would be a massive time saver for me as a creative!

Thank you!

[Aussiebear]

Welcome to VBAX ZoeZoe.

Have you had a look here? https://answers.microsoft.com/en-us/msoffice/forum/all/delete-empty-objects-from-slide/9b44484d-9933-465f-8ad1-70c93e00c907

[ZoeZoe]

Thanks Aussiebear, I did see that thread but it's not a complete code (I don't know how to write VBA to properly include anything)
I used chat PGT to help me make some coding but nothing has worked so far... I even asked it to reference that specific code with no luck.

Still exploring the options :-(

[John Wilson]

Try this for the first option


Sub killPLC()'kill empty pic placeholders
Dim osld As Slide
Dim S As Long
Dim counter As Long
For Each osld In ActivePresentation.Slides
For S = osld.Shapes.Count To 1 Step -1
With osld.Shapes(S)
If .Type = msoPlaceholder Then
If .PlaceholderFormat.Type = ppPlaceholderPicture Then
If Not .PlaceholderFormat.ContainedType = msoPicture Then
.Delete
counter = counter + 1
End If
End If
End If
End With
Next S
Next osld
MsgBox counter & " Placeholders deleted."
End Sub

[ZoeZoe]

Thank you John, that worked to remove the images but it leaves behind the empty placeholder, a work around I've found it to drag and drop all my images into the template, then copy and paste them to a new slide with no template applied, this does not copy the empty placeholders so I end up with only the pictures.

Also I have some VBA now that does what I needed for the rest, in case anyone is curious, this works for what I needed. I'm not sure why but bottom shape works to actually delete the top shape in the slide.


Sub MOD_2___Duplicate_and_delete()
ActiveWindow.Selection.SlideRange.Duplicate
' Go to the first slide
ActiveWindow.View.GotoSlide 1

Dim slide As slide
Dim bottomShape As shape


Set slide = ActiveWindow.View.slide
If slide.Shapes.Count > 0 Then
' Identify the bottom shape on the slide
Set bottomShape = slide.Shapes(slide.Shapes.Count)


' Delete the bottom shape
bottomShape.Delete
Else
End
End If
End Sub


And then this VBA runs that 200 times - unless there's not shapes left, then it stops.

Sub MOD_3___Duplicate_and_Delete_Repeat_200()
Dim i As Integer
Dim repeatCount As Integer

repeatCount = 200 ' Change this to the number of times you want to repeat the macro

For i = 1 To repeatCount
' Call your macro here
MOD_2___Duplicate_and_delete

' Introduce a delay (e.g., 1 second) before the next iteration
Dim startTime As Double
startTime = Timer
Do While Timer < startTime + 1
DoEvents
Loop
Next i
End Sub




Thanks for the hand, seems I got it sorted though!