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

时间:2017-07-24 11:37:24

标签: vba powerpoint powerpoint-vba

下面的代码没有考虑.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

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

2 个答案:

答案 0 :(得分:1)

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

<files count="1">
    <file name="info.txt" size="75435" modificationTime="20170724T160034+0200" href="/httpAuth/app/rest/builds/id:3906258/artifacts/metadata/output/logs/info.txt">
        <content href="/httpAuth/app/rest/builds/id:3906258/artifacts/content/output/logs/info.txt"/>
    </file>
</files>

希望这有帮助!

答案 1 :(得分:0)

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

我修改了主程序,只是将整个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
相关问题