hi all
anybody can provide me the gms or script to swap files hor as well as vertically.
For instance, left side circle and right side rectangle if you swap horizontally then left side comes rectangle and right side comes circle. please help me
Have you tried flipping the objects with Shift + Ctrl pressed. It would mirror the objects at its own place.
that's not my requirement. My requirement is, when there are 2 selected shapes will be swaped
Hello, I use the following macro for quickly swapping the position of two or more objects:
Sub swapPos() Dim c As Integer Dim x As Double, y As Double Dim x1 As Double, y1 As Double If Not ActiveSelection.Shapes.Count > 1 Then MsgBox "Select More than one Object to run this macro", vbInformation, "Oops!" Exit Sub End If ActiveDocument.ReferencePoint = cdrCenter c = 1 While c < ActiveSelection.Shapes.Count ActiveSelection.Shapes(c).GetPosition x, y ActiveSelection.Shapes(c + 1).GetPosition x1, y1 ActiveSelection.Shapes(c).SetPosition x1, y1 ActiveSelection.Shapes(c + 1).SetPosition x, y c = c + 1 WendEnd Sub
I use this a lot and have assigned shift + q as my keyboard shortcut. Hope it helps.
thank q so much brother. its good. Besides do you have any replace macro similar of this.
This macro will all selected objects with a copy of the first selected object. I use shift + x as my hotkey:
Sub ReplaceWithDuplicate()Dim ocount As IntegerDim s As ShapeDim tr As TextRange If Not ActiveSelection.Shapes.Count > 1 ThenMsgBox "Select More than one Object to run this macro"Exit SubEnd If ocount = ActiveSelection.Shapes.CountOptimization = TrueActiveDocument.BeginCommandGroup "Replace With Duplicate" While ocount > 1lay = ActiveSelection.Shapes(1).Layer.name'MsgBox layIf ActiveSelection.Shapes(ocount).Type = cdrTextShape Then If ActiveSelection.Shapes(ocount).Text.Type = cdrArtisticText Then ActiveSelection.Shapes(ocount).Text.Story.InsertAfter "txg" If ActiveSelection.Shapes(1).Type = cdrArtisticText Then If ActiveSelection.Shapes(1).Text.Type = cdrArtisticText Then ActiveSelection.Shapes(1).Text.Story.InsertAfter "txg" 'to make text align vertically End If End If Set s = ActiveSelection.Shapes(ocount).Duplicate s.AlignToShape cdrAlignVCenter, ActiveSelection.Shapes(1) Set tr = ActiveSelection.Shapes(ocount).Text.Story.Duplicate() tr.Start = tr.End - 3 tr.Delete Set tr = s.Text.Story.Duplicate() tr.Start = tr.End - 3 tr.Delete s.AlignToShape cdrAlignHCenter, ActiveSelection.Shapes(1) ActiveSelection.Shapes(1).Delete Else Set s = ActiveSelection.Shapes(ocount).Duplicate s.AlignToShape cdrAlignHCenter + cdrAlignVCenter, ActiveSelection.Shapes(1) ActiveSelection.Shapes(1).Delete End IfElse Set s = ActiveSelection.Shapes(ocount).Duplicate s.AlignToShape cdrAlignHCenter + cdrAlignVCenter, ActiveSelection.Shapes(1) ActiveSelection.Shapes(1).DeleteEnd Ifs.MoveToLayer ActivePage.AllLayers(lay)ocount = ocount - 1Wend ActiveDocument.EndCommandGroup Optimization = False Application.RefreshEnd Sub
To use this macro select the source object first then the target object or objects. Hope it's useful.
oh my great friend, thank q so much its working. i am in need of you, please ad me. My email : pkg_sriram@yahoo.com, yahoo chat : pkg_sriram. I ll also be online in this yahoo.
I am not good at these macros but have plenty of ideas as how the things to do
thank q
Glad it worked for you. If you have any other needs please post the ideas to the forum. If I have a macro that matches the idea I'll be glad to post it. Cheers.