CorelDraw中基于对象尺寸计算批量修改对象名称的VBA问询

我已在画布上创建了命名为A-Z的图形对象，现有一段VBA代码仅支持手动选中2个对象时运行，可将字母命名对象的对应数字（如B对应2、E对应5）赋予另一个选中对象。现在需要优化代码，实现无需逐个执行操作，通过匹配对象的宽高尺寸、旋转值，自动将同规格的非字母命名对象按序列改为对应数字，但多次修改代码均未成功。

原始功能代码 #

这段代码仅在选中2个对象时生效，将字母对象对应的数字赋值给另一个选中对象：

Sub ChangeObjectName()
    Dim sr As ShapeRange
    Dim s As Shape, s2 As Shape, s1 As Shape
    Dim newName As String
    Dim foundAlpha As Boolean
    Const START_NAME = "A"
    Const END_NAME = "Z"
    
    Set sr = ActiveSelectionRange
    If sr.Count <> 2 Then Exit Sub
    
    For Each s In sr
        If Len(s.Name) = 1 And s.Name Like "[A-Z]" Then
            foundAlpha = True
            Set s1 = s
        Else
            Set s2 = s
        End If
    Next s
    
    If Not foundAlpha Then Exit Sub
    
    If s1 Is Nothing Or s2 Is Nothing Then Exit Sub
    
    newName = CStr(Asc(s1.Name) - 64)
    s2.Name = newName
End Sub

我尝试修改的代码 #

以下是我尝试修改后的代码，但未能实现预期功能：

Sub ChangeObjectName()
    Dim sr As ShapeRange
    Dim s As Shape
    Dim alphaShape As Shape
    Dim alphaName As String
    Dim numericName As Integer
    Dim matchingShapes As New Collection
    Dim i As Integer, j As Integer
    Dim matchFound As Boolean
    
    Set sr = ActiveSelectionRange
    
    For Each s In sr
        If Len(s.Name) = 1 And s.Name Like "[A-Z]" Then
            alphaName = s.Name
            Set alphaShape = s
            Exit For
        End If
    Next s
    
    If alphaShape Is Nothing Then
        MsgBox "未找到字母命名的对象。", vbExclamation
        Exit Sub
    End If
    
    For Each s In sr
        If s.Name <> alphaName Then
            If s.SizeWidth = alphaShape.SizeWidth And s.SizeHeight = alphaShape.SizeHeight And s.Rotation = alphaShape.Rotation Then
                matchingShapes.Add s
            End If
        End If
    Next s
    
    numericName = 1
    For i = 1 To matchingShapes.Count
        matchFound = False
        For j = 1 To sr.Count
            If sr(j).Name = matchingShapes(i).Name Then
                sr(j).Name = Chr(64 + numericName)
                matchFound = True
                Exit For
            End If
        Next j
        If matchFound Then
            numericName = numericName + 1
        End If
    Next i
     
 End Sub

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