下面这个生成的代码没反应,不知是哪里问题?
以下是为 CorelDRAW 2024 编写的 VBA 宏,
用于按对象从左到右的顺序调整其叠放顺序(Z顺序),
确保最左侧的对象位于最上层:
vba
Sub ArrangeObjectsByLeftPosition()
Dim pg As Page
Dim sh As Shape
Dim shapeList() As Shape
Dim i As Long, j As Long
Dim tempSh As Shape
' 检查当前页面
Set pg = ActivePage
If pg.Shapes.Count = 0 Then Exit Sub
' 收集所有对象到数组
ReDim shapeList(1 To pg.Shapes.Count)
i = 0
For Each sh In pg.Shapes
i = i + 1
Set shapeList(i) = sh
Next
' 冒泡排序(按X坐标升序)
For i = 1 To UBound(shapeList) - 1
For j = i + 1 To UBound(shapeList)
If shapeList(i).Left > shapeList(j).Left Then
Set tempSh = shapeList(i)
Set shapeList(i) = shapeList(j)
Set shapeList(j) = tempSh
End If
Next j
Next i
' 从右到左调整Z顺序(最后处理最左侧对象)
For i = UBound(shapeList) To 1 Step -1
shapeList(i).OrderToFront
DoEvents
Next i
MsgBox "已完成对象排序!最左侧对象现在位于最上层。", vbInformation
End Sub 本帖最后由 petergh 于 2025-5-7 21:31 编辑
xiyanghxc 发表于 2025-5-7 18:09
下面这个生成的代码没反应,不知是哪里问题?
以下是为 CorelDRAW 2024 编写的 VBA 宏,
这段程序应该只是把对象存在数组,然后做了一个逻辑排序,没有输出什么信息。
Sub 按左边排序()
VGCore.ActiveDocument.BeginCommandGroup "按左边排序"
Dim userSelect As VGCore.ShapeRange
Set userSelect = VGCore.ActiveSelectionRange
'PrintShapesName userSelect.Shapes
userSelect.Sort "@shape1.com().LeftX>@shape2.com().LeftX"’重点在这一句,如果换成TopY就是顶端、BottomY就是底端、RightX是右边、PositionX是中心。
Dim S1 As VGCore.Shape
Set S1 = userSelect.Shapes(userSelect.Count)
For I = 1 To userSelect.Count
userSelect.Shapes(I).OrderToBack
Next
VGCore.ActiveDocument.EndCommandGroup
End Sub 这个有啥作用来的。
页:
1
[2]