This is the closest I could find: https://community.coreldraw.com/talk/coreldraw_graphics_suite_x5/f/coreldraw-graphics-suite-x5/25957/another-free-but-less-exciting-macro/121403#121403
But it aligns only 2 objects. And I cannot edit the macro
I need to align multiple objects, either horizontally or vertically (not all 16 variants of the above macro)
Something like attached picture (top row = before, bottom row = after).
Thanks.
Hello, everybodyI suggest You a working idea. Better solutions, optimizations and improvements are possible
This is a tutorial on working with Shapes, arrays, Object Data, Excel collaboration....
Greetings!
Private Sub UserForm_Activate()On Error Resume Next 'if data field exist ActiveDocument.DataFields.AddEx2 "", "webcgm", "DleftX", cdrDataTypeNumber, "", "", "", "General", True, True, FalseOn Error Resume Next 'if data field exist ActiveDocument.DataFields.AddEx2 "", "webcgm", "DrightX", cdrDataTypeNumber, "", "", "", "General", True, True, False
*********************************************************************************
Private Sub CommandButton96_Click()'I suggest You a working solution. Better solutions, optimizations and improvements are possible
'Important!'Reference to MS Excel must be set'bhbp_min = WorksheetFunction.Min(arr) 'works if reference to Excel library is set'at top of ufCommand or at the top of any Command module must be'Option Base 1 'arays start from 1CommandButton96 must be on ufCommands /User Form/
For BhBp_bg = 1 To ActiveSelectionRange.Shapes.Count'bettersolutions.com/.../option-base-1.htm
aaa = ActiveSelectionRange.Shapes.CountFor X = 1 To aaa'MsgBox ActiveSelectionRange.Shapes(X).LeftX * 25.4ActiveSelectionRange.Shapes(X).ObjectData.Item("DleftX") = Mid("a" & ActiveSelectionRange.Shapes(X).LeftX * 25.4, 2)
ActiveSelectionRange.Shapes(X).ObjectData.Item("DrightX") = Mid("a" & ActiveSelectionRange.Shapes(X).RightX * 25.4, 2)Nextshapes_count1 = ActiveSelectionRange.Shapes.Count Dim arr() As Double On Error GoTo label_exit ReDim arr(shapes_count1) For X = 1 To shapes_count1 arr(X) = ActiveSelectionRange.Shapes(X).ObjectData.Item("DleftX") 'MsgBox arr(X) Next bhbp_min = WorksheetFunction.Min(arr) 'MsgBox "THE SMALLEST DISTANCE FROM LEFT IS " & bhbp_min For X = 1 To shapes_count1 If arr(X) = bhbp_min Then BhBp_dot = ActiveSelectionRange.Shapes(X).RightX
ActiveSelectionRange.Shapes(X).Selected = False End If Next 'MsgBox ActiveSelectionRange.LeftX * 25.4 ActiveSelectionRange.LeftX = BhBp_dotlabel_exit: NextEnd Sub
The sample trims shapes left. Trimming shapes in any dirrection is possible after some changes of code.
I would appreciate it if someone could share a better solution
Works great !!! Thanks.