compress pictures using vba

[Guest]

Greetings,

PowerPoint 2003 has the ability to compress pictures that have already been
inserted (Select Format Picture, then click Compress on the Picture tab). Is
there a way to access this functionality with VBA? I'm automating a frequent
photo slideshow task and it'd be nice to keep the filesize down.

 

[bramvandriel]

Hi,

There is no simple way to do this. Below you will find a macro that uses a workaround (copy-pasting a smaller version of an image). In this case, it compresses all selected images. More comments below.

Public Sub ResizeAndCompressSelectedImages()

' To reduce the image resolution, we need a workaround that involves copy-pasting
' the image. Since we would then loose the current selection, let's store the
' relevant shapes in the current selection in a new Collection.
Dim oShape As Shape
Dim cShapes As New Collection
For Each oShape In ActiveWindow.Selection.ShapeRange

If oShape.Type = msoPicture Then cShapes.Add oShape​

Next oShape

' Now, reduce the resolution of all of the selected shapes, one at a time
Dim prevWidth As Single
Dim prevHeight As Single
For Each oShape In cShapes

prevWidth = oShape.width: prevHeight = oShape.height
oShape.LockAspectRatio = msoTrue
oShape.width = 40 ' Something small
oShape.Copy
ActiveWindow.View.PasteSpecial ppPastePNG
With ActiveWindow.Selection.ShapeRange(1)

.Left = oShape.Left:
.Top = oShape.Top
.width = prevWidth:
.height = prevHeight​

End With
oShape.Delete​

Next oShape​

End Sub