Find the type of a shape

Question

I want to show all the shape types that i have in a powerpoint presentation. I tried with those codes:

Private Sub CommandButton1_Click()


Dim it As String
Dim i As Integer
Dim Ctr As Integer
'''''''''''''''''
'Read-only  Long
'''''''''''''''''
For Each slid In ActivePresentation.Slides
    For Each s In slid.Shapes
    'No need to select the object in order to use it
    With s

    'But it is easier to watch when the object is selected
    'This next line is for demonstration purposes only.
    'It is not necessary
    s.Select

    Select Case .Type

        'Type 1
        Case msoAutoShape
            it = "an AutoShape. Type : " & .Type

        'Type 2
        Case msoCallout
            it = "a Callout. Type : " & .Type

        'Type 3
        Case msoChart
            it = "a Chart. Type : " & .Type

        'Type 4
        Case msoComment
            it = "a Comment. Type : " & .Type

        'Type 5
        Case msoFreeform
            it = "a Freeform. Type : " & .Type

        'Type 6
        Case msoGroup
            it = "a Group. Type : " & .Type

        ' If it's a group them iterate thru
        ' the items and list them

            it = it & vbCrLf & "Comprised of..."
            For Ctr = 1 To .GroupItems.Count
                it = it & vbCrLf & _
                    .GroupItems(Ctr).Name & _
                    ". Type:" & .GroupItems(Ctr).Type
            Next Ctr

        'Type 7
        Case msoEmbeddedOLEObject
            it = "an Embedded OLE Object. Type : " & .Type

        'Type 8
        Case msoFormControl
            it = "a Form Control. Type : " & .Type

        'Type 9
        Case msoLine
            it = "a Line. Type : " & .Type

        'Type 10
        Case msoLinkedOLEObject
            it = "a Linked OLE Object. Type : " & .Type
            With .LinkFormat
                it = it & vbCrLf & "My Source: " & _
                    .SourceFullName
            End With

        'Type 11
        Case msoLinkedPicture
            it = "a Linked Picture. Type : " & .Type
            With .LinkFormat
                it = it & vbCrLf & "My Source: " & _
                    .SourceFullName
            End With

        'Type 12
        Case msoOLEControlObject
            it = "an OLE Control Object. Type : " & .Type

        'Type 13
        Case msoPicture
            it = "a embedded picture. Type : " & .Type

        'Type 14
        Case msoPlaceholder
            it = "a text placeholder (title or regular text--" & _
                 "not a standard textbox) object." & _
                 "Type : " & .Type

        'Type 15
        Case msoTextEffect
            it = "a WordArt (Text Effect). Type : " & .Type

        'Type 16
        Case msoMedia
            it = "a Media object .. sound, etc. Type : " & .Type
            With .LinkFormat
                it = it & vbCrLf & " My Source: " & _
                .SourceFullName
            End With

        'Type 17
        Case msoTextBox
            it = "a Text Box."

        'Type 18 = msoScriptAnchor, not defined in PPT pre-2000 so we use the numeric value
        'Case msoScriptAnchor
        Case 18
            it = " a ScriptAnchor. Type : " & .Type

        'Type 19 = msoTable, not defined in PPT pre-2000 so we use the numeric value
        'Case msoTable
        Case 19
            it = " a Table. Type : " & .Type

        'Type 19 = msoCanvas, not defined in PPT pre-2000 so we use the numeric value
        'Case msoCanvas
        Case 20
            it = " a Canvas. Type : " & .Type

        'Type 21 = msoDiagram, not defined in PPT pre-2000 so we use the numeric value
        'Case msoDiagram
        Case 22
            it = " a Diagram. Type : " & .Type

        'Type 22 = msoInk, not defined in PPT pre-2000 so we use the numeric value
        'Case msoInk
        Case 22
            it = " an Ink shape. Type : " & .Type

        'Type 23 = msoInkComment, not defined in PPT pre-2000 so we use the numeric value
        'Case msoInkComment
        Case 23
            it = " an InkComment. Type : " & .Type


        'Type -2
        Case msoShapeTypeMixed
            it = "a Mixed object (whatever that might be)." & _
                 "Type : " & .Type

        'Just in case
        Case Else
            it = "a mystery!? An undocumented object type?" & _
                    " Haven't found one of these yet!"
    End Select

    MsgBox ("I'm " & it)
    End With
Next
Next
End Sub

I took that code from this one and modify a little bit but no one works for me:

   Sub Object_Types_on_This_Slide()
'Refers to each object on the current page and returns the Shapes.Type
'Can be very useful when searching through all objects on a page
Dim it As String
Dim i As Integer
Dim Ctr As Integer
'''''''''''''''''
'Read-only  Long
'''''''''''''''''
For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count
    'No need to select the object in order to use it
    With ActiveWindow.Selection.SlideRange.Shapes(i)

    'But it is easier to watch when the object is selected
    'This next line is for demonstration purposes only.
    'It is not necessary
    ActiveWindow.Selection.SlideRange.Shapes(i).Select

    Select Case .Type

        'Type 1
        Case msoAutoShape
            it = "an AutoShape. Type : " & .Type

        'Type 2
        Case msoCallout
            it = "a Callout. Type : " & .Type

        'Type 3
        Case msoChart
            it = "a Chart. Type : " & .Type

        'Type 4
        Case msoComment
            it = "a Comment. Type : " & .Type

        'Type 5
        Case msoFreeform
            it = "a Freeform. Type : " & .Type

        'Type 6
        Case msoGroup
            it = "a Group. Type : " & .Type

        ' If it's a group them iterate thru
        ' the items and list them

            it = it & vbCrLf & "Comprised of..."
            For Ctr = 1 To .GroupItems.Count
                it = it & vbCrLf & _
                    .GroupItems(Ctr).Name & _
                    ". Type:" & .GroupItems(Ctr).Type
            Next Ctr

        'Type 7
        Case msoEmbeddedOLEObject
            it = "an Embedded OLE Object. Type : " & .Type

        'Type 8
        Case msoFormControl
            it = "a Form Control. Type : " & .Type

        'Type 9
        Case msoLine
            it = "a Line. Type : " & .Type

        'Type 10
        Case msoLinkedOLEObject
            it = "a Linked OLE Object. Type : " & .Type
            With .LinkFormat
                it = it & vbCrLf & "My Source: " & _
                    .SourceFullName
            End With

        'Type 11
        Case msoLinkedPicture
            it = "a Linked Picture. Type : " & .Type
            With .LinkFormat
                it = it & vbCrLf & "My Source: " & _
                    .SourceFullName
            End With

        'Type 12
        Case msoOLEControlObject
            it = "an OLE Control Object. Type : " & .Type

        'Type 13
        Case msoPicture
            it = "a embedded picture. Type : " & .Type

        'Type 14
        Case msoPlaceholder
            it = "a text placeholder (title or regular text--" & _
                 "not a standard textbox) object." & _
                 "Type : " & .Type

        'Type 15
        Case msoTextEffect
            it = "a WordArt (Text Effect). Type : " & .Type

        'Type 16
        Case msoMedia
            it = "a Media object .. sound, etc. Type : " & .Type
            With .LinkFormat
                it = it & vbCrLf & " My Source: " & _
                .SourceFullName
            End With

        'Type 17
        Case msoTextBox
            it = "a Text Box."

        'Type 18 = msoScriptAnchor, not defined in PPT pre-2000 so we use the numeric value
        'Case msoScriptAnchor
        Case 18
            it = " a ScriptAnchor. Type : " & .Type

        'Type 19 = msoTable, not defined in PPT pre-2000 so we use the numeric value
        'Case msoTable
        Case 19
            it = " a Table. Type : " & .Type

        'Type 19 = msoCanvas, not defined in PPT pre-2000 so we use the numeric value
        'Case msoCanvas
        Case 20
            it = " a Canvas. Type : " & .Type

        'Type 21 = msoDiagram, not defined in PPT pre-2000 so we use the numeric value
        'Case msoDiagram
        Case 22
            it = " a Diagram. Type : " & .Type

        'Type 22 = msoInk, not defined in PPT pre-2000 so we use the numeric value
        'Case msoInk
        Case 22
            it = " an Ink shape. Type : " & .Type

        'Type 23 = msoInkComment, not defined in PPT pre-2000 so we use the numeric value
        'Case msoInkComment
        Case 23
            it = " an InkComment. Type : " & .Type


        'Type -2
        Case msoShapeTypeMixed
            it = "a Mixed object (whatever that might be)." & _
                 "Type : " & .Type

        'Just in case
        Case Else
            it = "a mystery!? An undocumented object type?" & _
                    " Haven't found one of these yet!"
    End Select

    MsgBox ("I'm " & it)
    End With
Next i
End Sub

Why it is not working? Am I doing something wrong?

do you have any error or simply no results?? The second one works for me quite ok :) — Kazimierz Jawor, Apr 15 '13 at 16:22
Yes it gave me an error... In activewindow. Now i dont have the pc with me so i cannot check. Tomorrow i will. Btw thanks! You are in all the vba threads that i am writing :) — Iban Arriola, Apr 15 '13 at 16:27
There are few activewindows line but I think you have an error in the first one which error I was able to reproduce right now, too. Do you want to run your subroutine only for one slide, active slide or slides selected? We can back to that tomorrow... — Kazimierz Jawor, Apr 15 '13 at 22:46
Yes I have the error in the first one. I want it for all the slides of my presentation because I have to check all the different types that are in the presentation to make different things it each one. — Iban Arriola, Apr 16 '13 at 12:41

score 2 · Answer 1 · answered Apr 18 '13 at 12:56

I found a way to make it while the slideshow is running. Here is the code:

   Private Sub CommandButton2_Click()
Dim sNum As Integer
Dim stri As String
Dim i, j As Integer
Dim right As Boolean
Dim value As MsoShapeType
Dim it As String
right = True
k = 0
j = 0
it = "Cannot convert the file due to the following problems:" & vbNewLine & vbNewLine





'ActivePresentation.Slides(1).Hyperlinks(1).SubAddress
For Each sld In ActivePresentation.Slides


    For i = 1 To sld.Shapes.Count

            'Type 1
            If sld.Shapes(i).Type = msoAutoShape Then
                it = it & "AutoShape" & vbNewLine

                right = False
            End If

            'Type 2
            If sld.Shapes(i).Type = msoCallout Then
                it = it & "Callout." & vbNewLine

                right = False
            End If

            'Type 3
            If sld.Shapes(i).Type = msoChart Then
                it = it + "Chart." & vbNewLine

                right = False
            End If

            'Type 4
            If sld.Shapes(i).Type = msoComment Then
                'it = it + "a Comment. Type : " & .Type
            End If

            'Type 5
            If sld.Shapes(i).Type = msoFreeform Then
                it = it + "Freeform." & vbNewLine

                right = False
            End If

            'Type 6
            If sld.Shapes(i).Type = msoGroup Then
                it = it + "Group." & vbNewLine

            ' If it's a group them iterate thru
            ' the items and list them

                it = it & vbCrLf & "Comprised of..."
                'For Ctr = 1 To .GroupItems.Count
                '    it = it & vbCrLf & _
                 '       .GroupItems(Ctr).Name & _
                '        ". Type:" & .GroupItems(Ctr).Type & vbNewLine
                'Next Ctr

                right = False
            End If

            'Type 7
            If sld.Shapes(i).Type = msoEmbeddedOLEObject Then
                it = it + "Embedded OLE Object" & vbNewLine

                right = False
            End If

            'Type 8
            If sld.Shapes(i).Type = msoFormControl Then
                it = it + "Form Control" & vbNewLine

                right = False
            End If

            'Type 9
            If sld.Shapes(i).Type = msoLine Then
                'it = it + "a Line. Type : " & .Type
            End If

            'Type 10
            If sld.Shapes(i).Type = msoLinkedOLEObject Then
                'it = it + "a Linked OLE Object. Type : " & .Type
                'With .LinkFormat
                '    it = it & vbCrLf & "My Source: " & _
                '        .SourceFullName
                'End With
            End If

            'Type 11
            If sld.Shapes(i).Type = msoLinkedPicture Then
                it = it + "Linked Picture" & vbNewLine
                'With .LinkFormat
                '    it = it + it & vbCrLf & "My Source: " & _
                '        .SourceFullName
                'End With

                right = False
            End If

            'Type 12
            If sld.Shapes(i).Type = msoOLEControlObject Then
                it = it & "OLE Control Object" & vbNewLine

                right = False
            End If

            'Type 13
            If sld.Shapes(i).Type = msoPicture Then
                it = it & "Embedded picture" & vbNewLine

                right = False
            End If

            'Type 14
            If sld.Shapes(i).Type = msoPlaceholder Then
                'it = it & "text placeholder (title or regular text--" & _
                 '    "not a standard textbox) object." & _
                 '    "Type : " & .Type

                  '   right = False
            End If

            'Type 15
            If sld.Shapes(i).Type = msoTextEffect Then
                'it = it + "WordArt (Text Effect). Type : " & .Type
            End If

            'Type 16
            If sld.Shapes(i).Type = msoMedia Then
                it = it & "Media object .. sound, etc" & vbNewLine
                'With .LinkFormat
                  '  it = it & vbCrLf & " My Source: " & _
                  '  .SourceFullName
                'End With

                right = False
            End If

            'Type 17
            If sld.Shapes(i).Type = msoTextBox Then
                'it = "a Text Box."
            End If

            'Type 18 = msoScriptAnchor, not defined in PPT pre-2000 so we use the numeric value
            'Case msoScriptAnchor
            If sld.Shapes(i).Type = 18 Then
                it = it & "ScriptAnchor" & vbNewLine


                right = False
            End If

            'Type 19 = msoTable, not defined in PPT pre-2000 so we use the numeric value
            'Case msoTable
            If sld.Shapes(i).Type = 19 Then
                'it = " a Table. Type : " & .Type
            End If

            'Type 19 = msoCanvas, not defined in PPT pre-2000 so we use the numeric value
            'Case msoCanvas
            If sld.Shapes(i).Type = 20 Then
                it = "Canvas" & vbNewLine

                right = False
            End If

            'Type 21 = msoDiagram, not defined in PPT pre-2000 so we use the numeric value
            'Case msoDiagram
            If sld.Shapes(i).Type = 21 Then
                it = it + "Diagram" & vbNewLine

                right = False
            End If

            'Type 22 = msoInk, not defined in PPT pre-2000 so we use the numeric value
            'Case msoInk
            If sld.Shapes(i).Type = 22 Then
                it = it + "Ink shape" & vbNewLine

                right = False
            End If

            'Type 23 = msoInkComment, not defined in PPT pre-2000 so we use the numeric value
            'Case msoInkComment
            If sld.Shapes(i).Type = 23 Then
                it = it + "InkComment" & vbNewLine

                right = False
            End If


            'Type -2
            If sld.Shapes(i).Type = msoShapeTypeMixed Then
                it = "Mixed object (whatever that might be)" & nvNewLine

                right = False
            End If

            'Just in case
            'Case Else
             '   it = "mystery!? An undocumented object type?" & _
              '          " Haven't found one of these yet!" & nvNewLine
              '
              '  right = False

        'End Select

        'MsgBox ("I'm " & it)
        'End With
    Next i
    Next
    Dim slidNum As Integer
    slidNum = 1
    For Each slid In ActivePresentation.Slides
        If slid.TimeLine.MainSequence.Count >= 1 Then
            it = it & "Number of animations in slide " & slidNum & ": " & Str(slid.TimeLine.MainSequence.Count) & vbNewLine
            right = False
        End If
        slidNum = slidNum + 1
    Next

If right = True Then
    For Each slid In ActivePresentation.Slides
         For i = 1 To slid.Hyperlinks.Count
            If slid.Hyperlinks(i).SubAddress = "" Then
                MsgBox "Address: " + slid.Hyperlinks(i).Address
            'MsgBox "Here there is a hyperlink: " + slid.Hyperlinks(i).Type
            Else

                MsgBox "Subaddress: " + slid.Hyperlinks(i).SubAddress
                stri = Mid(slid.Hyperlinks(i).SubAddress, 5, 1)
                sNum = CInt(stri) - 1
                MsgBox "The link must go to Story Number: " + Str(sNum)
            End If
        Next i
    Next
    ActivePresentation.SaveAs "c:\dink_presentation2", ppSaveAsPNG, msoTrue
Else
   MsgBox (it & vbNewLine & "Please fix this errors to before continue")
End If

Hope that it will be helpful for someone.

ok, but you still don't select that shape... however, good you solved it! +1 from me :) — Kazimierz Jawor, Apr 18 '13 at 13:04
Thanks man! Is always easier with such a good support as you gave me! ;) — Iban Arriola, Apr 18 '13 at 13:56

score 1 · Answer 2 · answered Apr 16 '13 at 12:54

1

If you want you subroutine to work for each slides of presentation than you need to put back external loop which you removed.

there are 3 lines which you need to remove and few which you need to put instead:

'For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count 'remove
    'With ActiveWindow.Selection.SlideRange.Shapes(i)        'remove
    'ActiveWindow.Selection.SlideRange.Shapes(i).Select      'remove

Dim sld As Slide
For Each sld In ActivePresentation.Slides
    sld.Select
    For i = 1 To sld.Shapes.Count

    With sld.Shapes(i)
        .Select
...
...
...
Next i
Next '<-- add this too

Hope I didn't miss anything :)

answered Apr 16 '13 at 12:54

Kazimierz Jawor

18,861
7
35
55

Finally today I am also without computer :( Tomorrow I will have for sure and I will tell you if it works. Thanks!! – Iban Arriola Apr 16 '13 at 13:28
It is not working for me... in the sld.Select it gives me the following error: Slide (unknown member): Invalid request. This view does not support selection. I comment that line to see where it arrives and in the line .Select I get another error. In this case it says: Shape (unknown member): Invalid request. To select a shape, its view must be active. I have to say that I am using a button to exec this code once the presentation is running. – Iban Arriola Apr 17 '13 at 09:11
That is rather important information, you are running slideshow when you want this macro to run?? – Kazimierz Jawor Apr 17 '13 at 09:15
Yes I put the code in a button. And to exec it I have to start the presentation and push the button. – Iban Arriola Apr 17 '13 at 09:22
It makes a big difference to be running the slideshow? Why? What is the difference? And I can only do it without running it? – Iban Arriola Apr 17 '13 at 10:49
1

If you are in SlideShow mode you won't be able to select shape on presented slide. Proposed procedure will work only in design mode. What you could do? **1.** obviously you can check the type of the shape, **2.** you can show type in msgbox, **3.** if you need to mark out of any shape you could use [that kind of logic](http://stackoverflow.com/a/15624900/2143262) – Kazimierz Jawor Apr 17 '13 at 20:43

Find the type of a shape

2 Answers2

Linked