compress pictures using vba

  • Thread starter Thread starter Guest
  • Start date Start date
G

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.
 
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
 
Back
Top