Enable object scaling on all document outlines

Hello everyone

I have a code I got on the net, I need you to activate the scale of all outlines, but it is only on the page. Could someone help please

Sub SCALEWITHIMAGE()
ApplyScaleWithShape ActivePage.Shapes

End Sub


Private Sub ApplyScaleWithShape(ss As Shapes)
Dim dDoc As Document, sh As Shape
For Each s In ss


If Not s.PowerClip Is Nothing Then ApplyScaleWithShape s.PowerClip.Shapes

Select Case s.Type
Case cdrTextShape, cdrRectangleShape, cdrMeshFillShape, cdrPolygonShape, _
cdrLinearDimensionShape, cdrEllipseShape, cdrCurveShape, cdrConnectorShape

If s.Outline.Type = cdrOutline And Not s.Outline.ScaleWithShape Then
s.Outline.ScaleWithShape = True
End If

Case cdrGroupShape
ApplyScaleWithShape s.Shapes
End Select
Next s

End Sub

Parents
  • try this

    Sub DocOutlinesToScale()
    Dim x#, y#, w#, h#, p As Page, doc As Document, sr As ShapeRange, s As Shape
    Set doc = Application.ActiveDocument
    Optimization = True
    On Error GoTo ErrHndler
    For Each p In doc.Pages
    p.Shapes.FindShapes.AddToSelection
    Set sr = ActiveSelectionRange
    For Each s In sr
    If s.Outline.ScaleWithShape = False Then
    s.RemoveFromSelection
    s.Outline.ScaleWithShape = True
    End If
    Next s
    Next p
    ErrHndler:
    Err.Clear
    Optimization = False
    ActiveWindow.Refresh
    End Sub

Reply Children
No Data