Changing Object Names Based on Initial Object Size Calculation in Coreldraw

I would like to ask. "Previously, I have already created Object Names A-Z on the Green Line" and I'm trying to create a VBA code, here's the code: works manually by selecting 2 objects

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

This code is used to change the names of objects based on Object Name Alphabet (A-Z). The code works when 2 objects are selected. If the Object Name is (B), then the name of the other object changes to (2). If (E) is selected, then the script will work to change the name of the object to (5), and so on.

Is it possible to update the code so that it can work more optimally without having to run it one by one? What I mean is, those objects were previously part of the same entity. By adding calculations of width & height (object size) / the same rotation value in the code, can it automatically change the Object Name that is not an Alphabet into Numbers according to their sequence?

I have made many attempts, and still unsuccessful.

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 "Tidak ada objek alfabet yang ditemukan.", 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

Note: It's untested code (w/o coreldraw sw.). Please backup your file before testing.

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
    ' Save all shapes with alpha name into Collection
    For Each s In sr
        If Len(s.Name) = 1 And s.Name Like "[A-Z]" Then
            matchingShapes.Add s
        End If
    Next s
    ' Loop through Collection
    For i = 1 To matchingShapes.Count
        ' Get the shape
        set alphaShape = matchingShapes(i)
        For j = 1 To sr.Count
            ' shape name is different
            If sr(j).Name <> alphaShape.Name Then
                ' shape properties are same
                If sr(j).SizeWidth = alphaShape.SizeWidth And sr(j).SizeHeight = alphaShape.SizeHeight And sr(j).Rotation = alphaShape.Rotation Then
                    ' Update shape name with digit
                    sr(j).Name = CStr(Asc(alphaShape.Name) - 64)
                End If
            End If
        Next j
    Next  
 End Sub

• Run the code to locate the error line.

Sub DebugShp()
    Dim sr As ShapeRange
    Dim s As Shape
    Set sr = ActiveSelectionRange
    Set s = sr(1)
    MsgBox s.SizeWidth
    MsgBox s.SizeHeight
    MsgBox s.RotationAngle
    MsgBox s.Rotation
End Sub