vbapowerpointpowerpoint-2010powerpoint-2013

Count the group of shapes in powerpoint without using .type property


The script which I have tested is running from excel application, which will count the shapes of pictures and count of actual shapes (that is textbox,placeholder) .Below is the script which pops up messages with the count of pictures and shapes

Sub countshapes()
Dim strname As String
Dim thisslide As Long
Dim strshape() As String

-----Count the number of slides in presentation 

For thisslide = 1 To ActivePresentation.Slides.count

With ActivePresentation.Slides(thisslide)
ReDim strshape(0 To 0)

For Each oshp In .Shapes

If InStr(1, oshp.Name, "Picture") > 0 Then
ReDim Preserve strshape(0 To a)
strshape(a) = oshp.Name
a = a + 1

Else

ReDim Preserve strshape(0 To d)
strshape(d) = oshp.Name
d = d + 1
End If

Next oshp
End With
Next
MsgBox a
MsgBox d

The count of shapes and pictures are displayed perfectly But am unable to get the count of group of shapes, this can be easily achieved by .type=msogroup property however that property will not help me in some of the presentations which have many grouped shapes.

Please help me to update the script by using name of the shapes likewise the above script


Solution

  • You've mentioned in your question that you don't want to use the .Type property w/o explaining the reason for this. Since it gives you a direct way to do what you need, I'll mention that you can test the .Type of each oShp and if it's msoGroup, oShp.GroupItems.Count will give you the number of shapes in the group. For example, you could pass each shape to this function and sum the results as you go:

    Function CountGroupShapes(oSh As Shape) As Long
        If oSh.Type = msoGroup Then
            CountGroupShapes = oSh.GroupItems.Count
        Else
            CountGroupShapes = 1
        End If
    End Function
    

    Bear in mind that this won't give accurate results if there are going to be groups within groups.