I'm trying to bitmap any raster image inside all the powerclips inside my document. This code turns the raster images into 2 pixel x 2 pixel bitmaps. This isn't the desired result. Anyone see the issue?
Sub RasterImageswPC()
Dim s As Shape, s2 As Shape, sr As ShapeRange, p As Page, pwc As PowerClip, sr2 As ShapeRange
For Each p In ActiveDocument.Pages
Set sr = p.Shapes.FindShapes
For Each s In sr
If Not s.PowerClip Is Nothing Then
Set pwc = s.PowerClip
Set sr2 = pwc.Shapes.FindShapes(, cdrBitmapShape)
For Each s2 In sr2
Set s2 = s2.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 150, cdrNormalAntiAliasing, True, False, 95)
Next s2
End If
Next s
Next p
End Sub
Any help is much appreciated.
As you want to edit PowerClip objects you should activate PowerClip editing mode
Sub RasterImageswPC()Dim s As Shape, s2 As Shape, sr As ShapeRange, p As Page, pwc As PowerClip, sr2 As ShapeRangeFor Each p In ActiveDocument.Pages Set sr = p.Shapes.FindShapes For Each s In sr If Not s.PowerClip Is Nothing Then Set pwc = s.PowerClip Set sr2 = pwc.Shapes.FindShapes(, cdrBitmapShape) pwc.EnterEditMode 'allowing PowerClip objects to have their contents edited. For Each s2 In sr2 Set s2 = s2.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 150, cdrNormalAntiAliasing, True, False, 95) Next s2 pwc.LeaveEditMode 'preventing PowerClip objects from having their contents edited End If Next s Next pEnd Sub
Best regards
Mek
Thanks a lot.
Is "If Not s.PowerClip Is Nothing Then" the only way to check for powerclips? It's such a strange line of code.