CODEWITHSUNDEEP
vbapowerpoint
Lalit k
Lalit k

Reputation: 49

Renaming Group Objects in PPT using VBA

Code below does not account for .GroupItems Anyone please could fix this?

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

Source: https://stackoverflow.com/a/34016348/8357374

Upvotes: 0

Views: 670

Answers (2)

David Zemens
David Zemens

Reputation: 53623

Try using recursion, since a grouped shape is just another (iterable) collection of shape objects.

I've modified the main procedure to simply pass the entire oSld.Shapes collection to a subroutine called SetShapeNames. Within this subroutine, if an individual object is of type msoGroup, then we call this subroutine recursively against that object.

Note: untested.

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

Upvotes: 0

Domenic
Domenic

Reputation: 8114

As your comment already suggests, you can loop through each shape/group item using the GroupItems property of the Shape object...

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

Hope this helps!

Upvotes: 1

Related Questions