Search in Powerclip

i found a solution :)

this is probably cumbersome and there is a more elegant solution, but i make all i can.

Dim SR As ShapeRange, SM As ShapeRange, GN As New ShapeRange, s As Shape, g As Shape, b As Shape, PG As New ShapeRange
On Error GoTo ErDn
ActiveDocument.BeginCommandGroup

ActiveLayer.Shapes.All.CreateSelection
For Each s In ActiveSelection.Shapes
If Not s.Type = cdrGroupShape Then
s.RemoveFromSelection
End If
Next
Set PG = ActiveSelectionRange
lngObjCount = ActiveSelection.Shapes.Count
For i = 1 To lngObjCount
PG(i).CreateSelection
ActiveSelection.UngroupAll
Set SM = ActiveSelectionRange
For Each g In ActiveSelection.Shapes.FindShapes(Query:="!@com.powerclip.IsNull")
Set SR = g.PowerClip.ExtractShapes
SR.UngroupAll
For Each b In ActiveSelection.Shapes
If Not b.Transparency.Type = cdrNoTransparency Then
Set AM = b.ConvertToBitmapEx(cdrCMYKColorImage, False, True, 200, cdrNormalAntiAliasing, True, False, 95)
Else
Set AM = b
End If
GN.Add AM
Next
GN.AddToPowerClip g, cdrFalse
Next
SM.Group
Next

ErDn:
ActiveDocument.EndCommandGroup
End Sub