Consulting

Results 1 to 3 of 3

Thread: VBA to Delete all Images in a PowerPoint

  1. #1

    VBA to Delete all Images in a PowerPoint

    Hi all,

    I'm currently looking for a simple VBA to delete all the images in a PowerPoint. I have tried solutions in a number of threads with no luck. At the moment I'm using a script which deletes all the pictures on a specific slide which works well but a simple 'delete all' button would be useful. The code I'm using at the moment is detailed below.

    Sub delete_pics()
    
    
    Dim osld As Slide
    Dim opic As Shape
    Dim lngCount As Long
    On Error GoTo err
    err.Clear
    For Each osld In ActiveWindow.Selection.SlideRange
    For lngCount = osld.Shapes.Count To 1 Step -1
    Set opic = osld.Shapes(lngCount)
    Select Case opic.Type
    Case Is = msoPlaceholder
    If opic.PlaceholderFormat.ContainedType = msoPicture Then opic.Delete
    Case Is = msoPicture
    opic.Delete
    End Select
    Next lngCount
    Next osld
    Exit Sub
    err:
    MsgBox "Did you select slides?"
    End Sub


    I'm new to Excel VBA therefore any simple code with simple instructions would be much appreciated!

    Thanks
    Last edited by Paul_Hossler; 06-09-2021 at 12:09 PM.

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    1. I added CODE tags to you post - use the [#] icon to add then

    2. Interesting. Deleting 'bottoms up' is still required, and I added the ability to handle a single level of grouped items

    3. I learned that if you delete all but one shape in a Group, then it becomes a 'regular' shape

    Option Explicit
    
    
    Sub delete_pics()
        Dim osld As Slide
        Dim oshp As Shape, oshp2 As Shape
        Dim iShp As Long, ishp2 As Long
        
        For Each osld In ActivePresentation.Slides
            For iShp = osld.Shapes.Count To 1 Step -1
            
                Set oshp = osld.Shapes(iShp)
            
                Select Case osld.Shapes(iShp).Type
                    
                    Case msoPlaceholder
                        If oshp.PlaceholderFormat.ContainedType = msoPicture Then oshp.Delete
                    
                    Case msoPicture
                        oshp.Delete
                    
                    Case msoGroup
                        For ishp2 = oshp.GroupItems.Count To 2 Step -1
                            
                            Set oshp2 = oshp.GroupItems(ishp2)
                        
                            Select Case oshp2.Type
                                Case msoPlaceholder
                                    If oshp2.PlaceholderFormat.ContainedType = msoPicture Then oshp2.Delete
                                Case msoPicture
                                    oshp2.Delete
                            End Select
                        Next ishp2
                End Select
            Next iShp
        
            'second pass since if a Group has all but 1 picture deleted, it's not a group any more
            For iShp = osld.Shapes.Count To 1 Step -1
            
                Set oshp = osld.Shapes(iShp)
            
                If oshp.Type = msoPicture Then oshp.Delete
            Next iShp
        
        Next
    
    
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Hi Paul,

    That is fantastic, works a treat. Thank you for your help

    All the best

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •