使用VBA重命名PPT中的组对象

下面的代码不包含。GroupItems是否有人可以修复此问题

Public Sub RenameOnSlideObjects()
      Dim oSld As Slide
      Dim oShp As Shape
      For Each oSld In ActivePresentation.Slides
        For Each oShp In oSld.Shapes
          With oShp
            Select Case True
              Case .Type = msoPlaceholder ' you could then check the placeholder type too
                .Name = "myPlaceholder"
              Case .Type = msoTextBox
                .Name = "myTextBox"
              Case .Type = msoAutoShape
                .Name = "myShape"
              Case .Type = msoChart
                .Name = "myChart"
              Case .Type = msoTable
                .Name = "myTable"
              Case .Type = msoPicture
                .Name = "myPicture"
              Case .Type = msoSmartArt
                .Name = "mySmartArt"
              Case .Type = msoGroup ' you could then cycle though each shape in the group
                .Name = "myGroup"
             Case Else
                .Name = "Unspecified Object"
            End Select
          End With
        Next
      Next
    End Sub

---

来源：

如您的评论所示，您可以使用shape对象的GroupItems属性循环浏览每个shape/group项

Public Sub RenameOnSlideObjects()
      Dim oSld As Slide
      Dim oShp As Shape
      Dim oGrpItm As Shape
      Dim GrpItmNum As Integer
      For Each oSld In ActivePresentation.Slides
        For Each oShp In oSld.Shapes
          With oShp
            Select Case True
              Case .Type = msoPlaceholder ' you could then check the placeholder type too
                .Name = "myPlaceholder"
              Case .Type = msoTextBox
                .Name = "myTextBox"
              Case .Type = msoAutoShape
                .Name = "myShape"
              Case .Type = msoChart
                .Name = "myChart"
              Case .Type = msoTable
                .Name = "myTable"
              Case .Type = msoPicture
                .Name = "myPicture"
              Case .Type = msoSmartArt
                .Name = "mySmartArt"
              Case .Type = msoGroup ' you could then cycle though each shape in the group
                .Name = "myGroup"
                GrpItmNum = 0
                For Each oGrpItm In .GroupItems
                    GrpItmNum = GrpItmNum + 1
                    oGrpItm.Name = "myGroupItem" & GrpItmNum
                Next oGrpItm
             Case Else
                .Name = "Unspecified Object"
            End Select
          End With
        Next
      Next
    End Sub

---

希望这有帮助

尝试使用递归，因为分组形状只是形状对象的另一个（可编辑）集合

我修改了主过程，将整个

oSld.Shapes

集合传递给名为

SetShapeNames

的子例程。在此子例程中，如果单个对象的类型为

msoGroup

，则我们针对该对象递归调用此子例程

注：未经测试

Public Sub RenameOnSlideObjects()
Dim oSld As Slide
For Each oSld In ActivePresentation.Slides
    Call SetShapeNames(oSld.Shapes)
Next
End Sub

Sub SetShapeNames(MyShapes)
Dim oShp as Shape
For Each oShp in MyShapes
    With oShp
        Select Case .Type
            Case msoPlaceholder ' you could then check the placeholder type too
                .Name = "myPlaceholder"
            Case msoTextBox
                .Name = "myTextBox"
            Case msoAutoShape
                .Name = "myShape"
            Case msoChart
                .Name = "myChart"
            Case msoTable
                .Name = "myTable"
            Case msoPicture
                .Name = "myPicture"
            Case msoSmartArt
                .Name = "mySmartArt"
            Case msoGroup ' // call this function recursively
                Call SetShapeNames(oShp.GroupItems)
            Case Else
                .Name = "Unspecified Object"
        End Select
    End With
Next
End Sub

---

恐怕这从一开始就注定了，除非你确定每张幻灯片上每种类型只有一个形状。你不能给两个形状取同一个名字。这很好，但对“一组一组”不起作用。你能帮帮忙吗？在这种情况下，用David的解决方案。只想指出一个拼写错误。正在调用的sub的名称应为SetShapeNames（带s）。@Domenic我会修复它，但非常欢迎您将来使用该按钮修复其他人答案中的明显打字错误（或其他错误）：）谢谢，我以后会这样做。