如何用vba给ppt幻灯片中的同类型的图形批量重命名?

如下图所示

ppt幻灯片中有6个矩形，名称分别为”矩形 N”的形式，现在想要批量将其名称换成”img N”的形式，可以使用如下的vba代码：

Sub QQ1722187970()
    Dim oPPT As Presentation
    Dim oSlide As Slide
    Dim oCL As CustomLayout
    Dim oP As Shape
    '当前ppt演示文稿
    Set oPPT = PowerPoint.ActivePresentation
    With oPPT
        '遍历每一个幻灯片
        For Each oSlide In .Slides
            i = 1
            With oSlide
                '遍历每一个图形
                For Each oP In .Shapes
                    With oP
                        sName = .Name
                        iType = .Type
                        If sName Like "*矩形*" Then
                            sName = "img" & i
                            .Name = sName
                            i = i + 1
                        End If
                    End With
                Next
            End With
        Next
    End With
End Sub

结果如下图所示：