CorelDraw VBA选中对象重命名顺序异常，需实现A-Z正序求助

问题场景 #

我编写的CorelDraw VBA脚本本应按A-Z顺序重命名选中对象，但实际执行时却是Z-A倒序；而针对全页对象的重命名脚本可正常按A-Z顺序运行。

原选中对象重命名脚本：

Sub RenameSelectedObjects()
    Dim i As Integer
    Const START_CHAR = 65 ' ASCII untuk 'A'
    Const END_CHAR = 90   ' ASCII untuk 'Z'
    Dim objCount As Integer
    Dim selectedShape As Shape
    
    i = 0
    objCount = ActiveSelectionRange.Count
    
    For Each selectedShape In ActiveSelectionRange
        If i > END_CHAR - START_CHAR Then Exit Sub
        selectedShape.Name = Chr(START_CHAR + i)
        i = i + 1
    Next selectedShape
End Sub

全页对象重命名脚本（正常运行）：

Sub RenameObjects()
    Dim i As Integer
    Const START_CHAR = 65 ' ASCII untuk 'A'
    Const END_CHAR = 90   ' ASCII untuk 'Z'
    
    i = 0
    For Each s In ActivePage.Shapes.All
        If i > END_CHAR - START_CHAR Then Exit Sub
        s.Name = Chr(START_CHAR + i)
        i = i + 1
    Next s
   
End Sub

问题原因 #

CorelDraw的ActiveSelectionRange默认遍历顺序为从最后选中的对象到最先选中的对象（与用户选中顺序反向），导致字母赋值顺序颠倒。而ActivePage.Shapes.All是按对象的创建/堆叠正序遍历，因此全页脚本正常。

修正后的脚本 #

Sub RenameSelectedObjects()
    Dim i As Integer
    Const START_CHAR = 65 ' ASCII 对应 'A'
    Const END_CHAR = 90   ' ASCII 对应 'Z'
    Dim objCount As Integer
    Dim selectedShapes() As Shape
    Dim idx As Integer
    
    objCount = ActiveSelectionRange.Count
    ' 无选中对象时直接退出
    If objCount = 0 Then Exit Sub
    
    ' 将选中对象存入数组，保留原遍历顺序
    ReDim selectedShapes(1 To objCount)
    idx = 1
    For Each s In ActiveSelectionRange
        Set selectedShapes(idx) = s
        idx = idx + 1
    Next s
    
    ' 反向遍历数组，实现A-Z正序赋值
    i = 0
    For idx = objCount To 1 Step -1
        If i > END_CHAR - START_CHAR Then Exit Sub
        selectedShapes(idx).Name = Chr(START_CHAR + i)
        i = i + 1
    Next idx
End Sub

改动说明 #

• 新增数组selectedShapes存储所有选中对象，暂存ActiveSelectionRange的遍历顺序
• 通过反向遍历数组，让最先选中的对象优先获得A、B、C...的命名，实现预期的正序效果
• 增加无选中对象的判断逻辑，避免空引用报错

内容的提问来源于stack exchange，提问作者redixid hkgraphics