求vba代码对对象在图层的顺序重排

xiyanghxc

下面这个生成的代码没反应，不知是哪里问题？
测试文件.rar (11.8 KB)

4 天前 上传

点击文件名下载附件

以下是为 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

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

彩广告

这个有啥作用来的。