1

I have a powerpoint presentation where the photo on each slide is a large file size (.EMF). I would like to change them all to .PNG to make the final file size much smaller.

So far, I have this:

Sub ConvertShapeToPNG()
    Dim osh As Shape
    Set osh = ActiveWindow.Selection.ShapeRange(1)
    osh.Copy
    ActiveWindow.Selection.SlideRange.Shapes.PasteSpecial ppPastePNG
    osh.Delete
End Sub

This will take a picture that is selected on a slide and replace it with a PNG. I am having trouble having this work throughout a presentation as it wants me to select the picture first.

This is my code for the full presentation version:

Sub ConvertAllShapesToPNG()

Dim osld As Slide
Dim osh As Shape

For Each osld In ActivePresentation.Slides
    For Each osh In osld.Shapes
        Set osh = ActiveWindow.Selection.ShapeRange(1)
        osh.Copy
        ActiveWindow.Selection.SlideRange.Shapes.PasteSpecial ppPastePNG
        osh.Delete
    Next
Next osld

End Sub

Can anyone help me run this code properly throughout an entire presentation? Thanks!

EDIT: It would also be ideal if the photos would copy to the same location as the original photo instead of copying to the centre of the slide but I have not tried this myself yet.

1 Answer 1

1

I figured it out myself!

Here is the code if anyone is curious:

Sub ConvertAllShapesToPNG()
'PURPOSE: Change Pictures into .PNG images

Dim shp As Shape
Dim sld As Slide
Dim pic As Shape
Dim shp_left As Double
Dim shp_top As Double

'Loop Through Each Slide in ActivePresentation
  For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes

      If shp.Type = msoPicture Then
        'Retrieve current positioning
          shp_left = shp.Left
          shp_top = shp.Top

        'Copy/Paste as .PNG Picture
          shp.Copy

          sld.Shapes.PasteSpecial DataType:=ppPastePNG

          Set pic = sld.Shapes(sld.Shapes.Count)

        'Delete Linked Shape
          shp.Delete

        'Reposition newly pasted picture
          pic.Left = shp_left
          pic.Top = shp_top

      End If

    Next shp
  Next sld

  MsgBox "All photos are now .PNGs"

End Sub

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.