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

Question

下面的代码不考虑 .组项目 任何人都可以解决这个问题吗？

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

来源： https://stackoverflow.com/a/34016348/8357374

Answer 1

正如您的评论已经建议的那样，您可以使用 Shape 对象的 GroupItems 属性遍历每个形状/组项...

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

希望这有帮助！

Answer 2

尝试使用递归，因为分组形状只是形状对象的另一个(可迭代(集合。

我修改了主过程，只需将整个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