Replace shape with another shape.

Anonymous
Anonymous

Hi. I found a macro on the web ..
The macro works well with rotated objects....But not with mirrored objects.
How to make the macro work with mirrored objects?

Macro Code:

Sub scatter()
   Dim sh As Shape, sr As ShapeRange, x#, y#, w#, h#, i&
   Dim AgentSmith As Shape, VSR As ShapeRange
   
   If ActiveDocument Is Nothing Then Exit Sub
   Set sr = ActiveSelection.Shapes.FindShapes()
   If sr.Count = 0 Then
      MsgBox "Select target objects, invoke the macro, click Agent Smith shape"
      Exit Sub
   End If
   If ActiveDocument.GetUserClick(x, y, i, -1, Snap:=False, CursorShape:=313) Then _
      Exit Sub
   
   With ActivePage.SelectShapesAtPoint(x, y, SelectUnfilled:=True)
      If .Shapes.Count = 0 Then Beep: Exit Sub
      Set AgentSmith = .Shapes(.Shapes.Count)
   End With

   Set VSR = New ShapeRange
   ActiveDocument.ReferencePoint = cdrCenter
   For Each sh In sr
      sh.GetBoundingBox x, y, w, h
      With AgentSmith.TreeNode.GetCopy
         .VirtualShape.RotationAngle = sh.RotationAngle
         .VirtualShape.SetBoundingBox x, y, w, h, KeepAspect:=True
         .LinkAsChildOf sh.Layer.TreeNode
         VSR.Add .VirtualShape
      End With
   Next
   
   ActiveDocument.LogCreateShapeRange VSR
   sr.Delete ' evaporate originally selected shapes
End Sub

Replace shape....cdr

Parents Reply Children