How to recursively find powerclip inside powerclip

[aakkaarr]

How to recursively find powerclip inside powerclip and edit its contents via VBA

[shelbym]

When you say edit the contents, what would you like to do?

-Shelby

[aakkaarr]

I have to convert rotated bitmaps inside the nested powerclip by again making them bitmap

[shelbym]

Here is a little example:

Sub TestFindAllShapes()
    Dim s As Shape, sr As ShapeRange
    
    Set sr = FindAllShapes.Shapes.FindShapes(Type:=cdrBitmapShape)
    
    For Each s In sr.Shapes
        s.Bitmap.ConvertToBW cdrRenderLineArt
    Next s
End Sub

Function FindAllShapes() As ShapeRange
    Dim s As Shape
    Dim sr As ShapeRange
    Dim srAll As New ShapeRange, srPowerClipped As New ShapeRange

    If ActiveSelection.Shapes.count > 0 Then
        Set sr = ActiveSelection.Shapes.FindShapes()
    Else
        Set sr = ActivePage.Shapes.FindShapes()
    End If
    
    Do
        For Each s In sr.Shapes.FindShapes(Query:="!@com.powerclip.IsNull")
            srPowerClipped.AddRange s.PowerClip.Shapes.FindShapes()
        Next s
        
        srAll.AddRange sr
        sr.RemoveAll
        sr.AddRange srPowerClipped
        srPowerClipped.RemoveAll
    Loop Until sr.count = 0
    
    Set FindAllShapes = srAll
End Function

Hope that helps,

-Shelby

[aakkaarr]

my sample file is attached, pls see what can be done

[shelbym]

Just change the line:

s.Bitmap.ConvertToBW cdrRenderLineArt

to

s.Bitmap.Resample , , True, 300, 300

Best of luck,

-Shelby