find and none outline of a mentioned height and width object in x6 on all pages of a document wheather its in powerclip or outside of powerclip ?
I'm afraid I do not understand what you wont... Do you need to find all shapes having specific dimensions and make their outline 'None'? If the shape having those specific dimensions is inside PowerClip or Groups (I suppose), too...
What about that:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
Sub btOutlineNone() Dim s As Shape, Pagini As Long, i As Long, nr As Long, j As Long, pc As PowerClip, sh As Shape Dim Pg As Long, PgActuala As Long, shWidth As Double, shHeight As Double ActiveDocument.Unit = cdrMillimeter 'A shape with the necessary dimensions must be selected!!! If ActiveSelection.Shapes.Count = 0 Then MsgBox "You did not select any shape." & vbCrLf & _ " We will stop...", , "Selection missing": End ElseIf ActiveSelection.Shapes.Count > 1 Then MsgBox "You selected more then one shape." & _ vbCrLf & " We will stop...", , "More shapes selected": End End If shWidth = ActiveShape.SizeWidth: shHeight = ActiveShape.SizeHeight ActiveDocument.BeginCommandGroup "No Outline" For j = 1 To ActiveDocument.Pages.Count For Each s In ActiveDocument.Pages(j).Shapes If s.Type = cdrGroupShape Then For i = 1 To s.Shapes.Count If s.Shapes(i).SizeWidth = shWidth And s.Shapes(i).SizeHeight = shHeight Then s.Shapes(i).Outline.Type = cdrNoOutline nr = nr + 1 End If Next i Else Set pc = Nothing On Error Resume Next Set pc = s.PowerClip On Error GoTo 0 If Not pc Is Nothing Then For Each sh In pc.Shapes If sh.SizeWidth = shWidth And sh.SizeHeight = shHeight Then sh.Outline.Type = cdrNoOutline nr = nr + 1 End If Next Else If s.SizeWidth = shWidth And s.SizeHeight = shHeight Then s.Outline.Type = cdrNoOutline nr = nr + 1 End If End If End If Next s Next j ActiveDocument.EndCommandGroup MsgBox "Made outline = None for " & nr & " Shapes.", , "Number of solved shapes" End Sub
You need to select a shape having the wished dimensions. It looks also in groups. The process of outline elimination can be undone. I mean with Undo you can reverse all changes...
Or this one using CQL:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
Sub btOutlineNone_Bis() Dim s As Shape, nr As Long, j As Long, pc As PowerClip, sh As Shape Dim shWidth As Double, shHeight As Double, sr As ShapeRange ActiveDocument.Unit = cdrMillimeter 'A shape with the necessary dimensions must be selected!!! If ActiveSelection.Shapes.Count = 0 Then MsgBox "You did not select any shape." & vbCrLf & _ " We will stop...", , "Selection missing": End ElseIf ActiveSelection.Shapes.Count > 1 Then MsgBox "You selected more then one shape." & _ vbCrLf & " We will stop...", , "More shapes selected": End End If shWidth = ActiveShape.SizeWidth: shHeight = ActiveShape.SizeHeight ActiveDocument.BeginCommandGroup "No Outline" For j = 1 To ActiveDocument.Pages.Count For Each s In ActiveDocument.Pages(j).Shapes Set pc = Nothing On Error Resume Next Set pc = s.PowerClip On Error GoTo 0 If Not pc Is Nothing Then For Each sh In pc.Shapes If sh.SizeWidth = shWidth And sh.SizeHeight = shHeight Then sh.Outline.Type = cdrNoOutline nr = nr + 1 End If Next End If Next s Set sr = ActiveDocument.Pages(j).Shapes.FindShapes( _ Query:="@width = {" & shWidth & "mm" & "} and @height = {" & shHeight & "mm" & "}") nr = nr + sr.Shapes.Count For Each sh In sr sh.Outline.Type = cdrNoOutline Next Next j ActiveDocument.EndCommandGroup MsgBox "Made outline = None for " & nr & " Shapes.", , "Number of solved shapes" End Sub