I need a macro that copies the angle and coordinates of one object and applies it to another object. I found on the Internet a similar macro and edited it for my task. It works only if you select both objects and run the macro. I want to change it a little, but I do not have the necessary skills.I need the following algorithm:1) Run the macro2) Click on the first object3) Click on the second object4) The macro performs its work
Thanks!
Here is the macro:
Sub MyAngle() Dim s1 As Shape, s2 As Shape Dim x As Double, y As Double
Set s1 = ActiveShape 'Select first shape s1.GetPositionEx cdrCenter, x, y Set s2 = ActiveShape 'Select second shape s2.SetPositionEx cdrCenter, x, y 'Move first shape to second shape position s2.RotationAngle = s1.RotationAngle 'Set first shape angle as second shape angle s1.Delete 'Delete first shapeEnd Sub
For simple macros, it can be convenient to work with the active selection range, and use the order of selection to identify the objects in that selection range.
The first item in the shaperange is the last one selected, so to use this code one would:
Sub whatever() Dim s1 As Shape Dim s2 As Shape Set s1 = ActiveSelectionRange(1) Set s2 = ActiveSelectionRange(2) s2.RotationAngle = s1.RotationAngle s2.CenterX = s1.CenterX s2.CenterY = s1.CenterY s1.Delete End Sub
Thanks a lot! This simple macro will save me a lot of time