CODEWITHSUNDEEP
vbapowerpointimage-conversion
Shane
Shane

Reputation: 21

Changing the file type of photos in Powerpoint presentation using VBA?

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.

Upvotes: 1

Views: 122

Answers (1)

Shane
Shane

Reputation: 21

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

Upvotes: 1

Related Questions