Welcome. I would like to ask for help in writing a macro that duplicates the last selected object and places copies in separate PowerClips.
The loop should look like this:
.GetSize of first PowerClip object
duplicate the last previously selected object
make size of copied object same as first Powerclip
place the copied object do the first PowerClip
and the same loop for other powek clips
I would be grateful for your help :)
This works for me in a recent version of CorelDRAW. I don't know if there is anything that would need to be changed to make it work in X4.
Sub dupe_to_powerclips() Dim sToDupe As Shape Dim sDupe As Shape Dim sr As ShapeRange Dim lngCounter As Long On Error GoTo ErrHandler ActiveDocument.BeginCommandGroup "Dupe to PowerClips" Set sr = ActiveSelectionRange Set sToDupe = sr(1) For lngCounter = 2 To sr.Count Set sDupe = sToDupe.Duplicate sDupe.SetSize sr(lngCounter).SizeWidth, sr(lngCounter).SizeHeight sDupe.AddToPowerClip sr(lngCounter), cdrTrue Next lngCounter ExitSub: ActiveDocument.EndCommandGroup Exit Sub ErrHandler: MsgBox "Error occured: " & Err.Description Resume ExitSub End Sub
In use, it looks like this:
VIDEO: Dupe to PowerClips
.
Hello friend, how do you make this same macro be used with the power clip inserted proportionally.
This is similar code that keeps the objects proportional:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
Sub dupe_to_powerclips_proportional() Dim sToDupe As Shape Dim sDupe As Shape Dim sr As ShapeRange Dim lngCounter As Long On Error GoTo ErrHandler ActiveDocument.BeginCommandGroup "Dupe to PowerClips Proportional" Set sr = ActiveSelectionRange Set sToDupe = sr(1) For lngCounter = 2 To sr.Count Set sDupe = sToDupe.Duplicate 'compare aspect ratios of object and PowerClip If sDupe.SizeWidth / sDupe.SizeHeight < sr(lngCounter).SizeWidth / sr(lngCounter).SizeHeight Then 'resize based on height of PowerClip sDupe.SetSize sDupe.SizeWidth * sr(lngCounter).SizeHeight / sDupe.SizeHeight, sr(lngCounter).SizeHeight Else 'resize based on width of PowerClip sDupe.SetSize sr(lngCounter).SizeWidth, sDupe.SizeHeight * sr(lngCounter).SizeWidth / sDupe.SizeWidth End If sDupe.AddToPowerClip sr(lngCounter), cdrTrue Next lngCounter ExitSub: ActiveDocument.EndCommandGroup Exit Sub ErrHandler: MsgBox "Error occured: " & Err.Description Resume ExitSub End Sub
I started using this macro, in my case the object is already a powerclip, so I need that after making copies the object that is powerclip extract and be without a container.Eskimó or someone else can help me? rsrs