PDA

View Full Version : Auto compress pictures



Ron C?ppers
01-17-2009, 09:53 AM
Hi there,

I want to automatticaly compress pictures i added to my worksheet. I used the next macro, it runs but does not compress the pictures.
Has anyone got a solution?


Sub CompressPictures()
' Macro to compress all pictures
' Last change 7-1-2009
Dim DrObj
Dim Pict
Set DrObj = ActiveSheet.DrawingObjects
For Each Pict In DrObj
If Left(Pict.Name, 7) = "Picture" Then
Pict.Select
'With Selection
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
'End With
End If
Next
End Sub

Artik
01-18-2009, 05:59 PM
It's strange, but M$ didn't give the possibility of image compression by VBA. You can only try by SendKeys. :(

Artik

Ron C?ppers
01-19-2009, 01:33 AM
That is a pitty! :dunno I do not have experience with sendkeys but i will check the forum.

Thanks, Ron.