is there any macro that can move object next to the previous object just like in the attached GIF ?
Yes, use it everyday. It's called ButtShapes.
can you please share with me.
I can't take credit for creating it. I believe I started with 1 code and then created different ones to make
butt left/right, up/ down, top/bottom then I made a custom arrow icon for each to add to my workspace
Sub Bottom() Dim s As Shape, sr As ShapeRange Dim y As Double ActiveDocument.ReferencePoint = cdrBottomMiddle Set sr = ActiveSelectionRange SendKeys "r" DoEvents Set s = sr(1) sr.Remove 1 y = s.PositionY ActiveDocument.ReferencePoint = cdrTopMiddle boostStart "Align Bottom" For Each s In sr s.PositionY = y Next s boostFinish True, TrueEnd Sub
Here's one that accomplishes the same thing, but might be easier to modify for a larger variety of ways of positioning the shapes.
Sub mate_bottom_center() Dim sr As ShapeRange Dim sReference As Shape Dim s As Shape Set sr = ActiveSelectionRange Set sReference = sr(1) sr.Remove sr.IndexOf(sReference) For Each s In sr s.TopY = sReference.BottomY s.CenterX = sReference.CenterX Next s End Sub
Sir can you please show the rest directions code means LEFT,RIGHT,TOP,BOTTOM AND DIAGONALLY as well?
Sub mate_HLeft_VTop() Dim sr As ShapeRange Dim sReference As Shape Dim s As Shape Set sr = ActiveSelectionRange Set sReference = sr(1) sr.Remove sr.IndexOf(sReference) For Each s In sr s.BottomY = sReference.TopY s.RightX = sReference.LeftX Next s End Sub Sub mate_HCenter_VTop() Dim sr As ShapeRange Dim sReference As Shape Dim s As Shape Set sr = ActiveSelectionRange Set sReference = sr(1) sr.Remove sr.IndexOf(sReference) For Each s In sr s.BottomY = sReference.TopY s.CenterX = sReference.CenterX Next s End Sub Sub mate_HRight_VTop() Dim sr As ShapeRange Dim sReference As Shape Dim s As Shape Set sr = ActiveSelectionRange Set sReference = sr(1) sr.Remove sr.IndexOf(sReference) For Each s In sr s.BottomY = sReference.TopY s.LeftX = sReference.RightX Next s End Sub Sub mate_HLeft_VCenter() Dim sr As ShapeRange Dim sReference As Shape Dim s As Shape Set sr = ActiveSelectionRange Set sReference = sr(1) sr.Remove sr.IndexOf(sReference) For Each s In sr s.CenterY = sReference.CenterY s.RightX = sReference.LeftX Next s End Sub Sub mate_HRight_VCenter() Dim sr As ShapeRange Dim sReference As Shape Dim s As Shape Set sr = ActiveSelectionRange Set sReference = sr(1) sr.Remove sr.IndexOf(sReference) For Each s In sr s.CenterY = sReference.CenterY s.LeftX = sReference.RightX Next s End Sub Sub mate_HLeft_VBottom() Dim sr As ShapeRange Dim sReference As Shape Dim s As Shape Set sr = ActiveSelectionRange Set sReference = sr(1) sr.Remove sr.IndexOf(sReference) For Each s In sr s.TopY = sReference.BottomY s.RightX = sReference.LeftX Next s End Sub Sub mate_HCenter_VBottom() Dim sr As ShapeRange Dim sReference As Shape Dim s As Shape Set sr = ActiveSelectionRange Set sReference = sr(1) sr.Remove sr.IndexOf(sReference) For Each s In sr s.TopY = sReference.BottomY s.CenterX = sReference.CenterX Next s End Sub Sub mate_HRight_VBottom() Dim sr As ShapeRange Dim sReference As Shape Dim s As Shape Set sr = ActiveSelectionRange Set sReference = sr(1) sr.Remove sr.IndexOf(sReference) For Each s In sr s.TopY = sReference.BottomY s.LeftX = sReference.RightX Next s End Sub
you always rocks. Thanks eskimo
i have made a frame for this but i am getting this error on not selecting 2 shapes.please help in this too. what should i do now?
paraggoyal said:i have made a frame for this but i am getting this error on not selecting 2 shapes.please help in this too.
Do you have two objects selected before you run the macro?
I am getting this error only on not selecting 2 objects. I think some IF command will work here but i dont know what command should i use. Please help