CODEWITHSUNDEEP
vbaexcelpowerpoint
crazyfrog
crazyfrog

Reputation: 95

Replace existing image in MS PowerPoint with a new image using VBA

I'm updating my MS PowerPoint by pasting images on different slides using VBA.

Rest of the code is working fine. What I'm unable to do is delete the existing image on all the slides and paste the new image. Currently it paste the new image on top of old image, but old image remains. I'm using below code:

Dim pptApp  As PowerPoint.Application
Set pptApp = CreateObject("PowerPoint.Application")

pptApp.Visible = msoTrue

xlApp.Worksheets(2).Range("M2:S12").Copy
Set shp1 = ActivePresentation.Slides(17).Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1)

With shp1
    .Left = 370
    .Top = 100
    .Height = 360
    .Width = 340
End With

Being a newbie to VBA, I dont know where and how to add delete command in above code. Any kind of help would be appreciated.

Upvotes: 2

Views: 6033

Answers (2)

Steve Rindsberg
Steve Rindsberg

Reputation: 14809

This (thanks, L42) will work for single msoPicture shapes on a slide, but if there's more than one shape, it may miss some:

Dim s As Shape

For Each s In ActivePresentation.Slides(17).Shapes
    If s.Type = 13 Then s.Delete '13 is msoPicture
Next

Why? Suppose you have three shapes on the slide. We iterate through the shapes collection, find that the first shape is a picture and delete it. Now there are two shapes in the shapes collection, but VBA's counter doesn't take account of changes in the collection count. It looks at the second shape in the collection, but that's now what WAS the third shape on the slide, so the code will miss shape #2 altogether.

It's more reliable to use something like this:

Dim x as Long

For x = ActivePresentation.Slides(17).Shapes.Count to 1 Step -1
    If ActivePresentation.Slides(17).Shapes(x).Type = msoPicture Then
        ActivePresentation.Slides(17).Shapes(x).Delete
    End If
Next

Upvotes: 2

L42
L42

Reputation: 19737

Edit1: As what Steve pointed out, the first posted solution is unreliable; also as confirmed in this POST by Doug.

To delete all pictures using loop, take Steve's approach as explained in his post.
Now, if you just want to delete all the pictures, you can try this:

ActivePresentation.Slides(17).Shapes.Range.Delete

But this deletes all shapes, not only pictures but textboxes, lines, shapes etc.
To delete only pictures, below is another approach using loop.

Dim s As Shape, pictodel As Variant
For Each s In ActivePresentation.Slides(17).Shapes
    If s.Type = 13 Then
        If IsArray(pictodel) Then
            ReDim Preserve pictodel(UBound(pictodel) + 1)
            pictodel(UBound(pictodel)) = s.Name
        Else
            pictodel = Array(s.Name)
        End If
    End If
Next
ActivePresentation.Slides(17).Shapes.Range(pictodel).Delete

Hope this helps but a simpler solution would be Steve's. :)

Upvotes: 0

Related Questions