Selecting the shape being info'ed and setting up a loop counter

[leaning]

Hello!

I am still banging around with this Shape Info macro, but I am stuck in a few places.

1) I can't get the count "1 of 19", etc. to be on the same msgbox as the info box. I don't know how to set it up for when it runs through the Comment box portion of the macro. So for each shape, you have acknowledge two msgboxes instead of only one.

So, the one msgbox example for each shape should look like:

Analyzing: 1 of 19 Shapes
Object Type:
Name:
Location:
Visibility


2) When it finds a shape, it should "Select" it, so that the user can see what the info is describing. I can't figure out the syntax for select.

I attached the tester workbook full of shapes that I run the code on.

I appreciate any help!

VR/Lost

Private Sub btnListSheetObjects_Click()

'Display what workbook is being tested.
WorkbookName = ActiveWorkbook.Name
MsgBox "Testing Workbook " & WorkbookName
    
'Set types for different objects
Dim objType(-2 To 24) As String
    objType(1) = "AutoShape"
    objType(2) = "Callout"
    objType(20) = "Canvas"
    objType(3) = "Chart"
    objType(4) = "Comment"
    objType(21) = "Diagram"
    objType(7) = "Embedded OLE object"
    objType(8) = "Form control"
    objType(5) = "Freeform"
    objType(6) = "Group"
    objType(24) = "SmartArt graphic"
    objType(22) = "Ink"
    objType(23) = "Ink comment"
    objType(9) = "Line"
    objType(10) = "Linked OLE object"
    objType(11) = "Linked picture"
    objType(16) = "Media"
    objType(12) = "OLE control object"
    objType(13) = "Picture"
    objType(14) = "Placeholder"
    objType(18) = "Script anchor"
    objType(-2) = "Mixed shape type"
    objType(19) = "Table"
    objType(17) = "Text box"
    objType(15) = "Text effect"

'Get the number of objects
Dim objCount As Integer
objCount = ActiveSheet.Shapes.count
If objCount = 0 Then
MsgBox "There are no shapes on " & ActiveSheet.Name & "."
Else
Dim objPlural As String
objPlural = IIf(objCount = 1, "", "s")
MsgBox "There are " & Format(objCount, "0") & " Shape" & objPlural & " on Sheet " & ActiveSheet.Name & "."

'Loop through the objects
Dim X As Integer
For X = 1 To objCount
MsgBox "Analyzing object " & X & " of " & objCount & "."
'ActiveSheet.Shapes(X).Select
    
'Handle comments differently because they could be part of a merged range.
        If ActiveSheet.Shapes(X).Type = msoComment Then
        'Use comment section below.
        
        Else
        
'Handle msoFormControls differently because of the location not tied to cells.
        If ActiveSheet.Shapes(X).Type = msoFormControl Then
            MsgBox "Object Type: " & objType(ActiveSheet.Shapes(X).Type) & " (Type # " & ActiveSheet.Shapes(X).Type & ")" & vbCrLf & _
            "Name: " & ActiveSheet.Shapes(X).Name & vbCrLf & _
            "Location (between (at)): " & ActiveSheet.Shapes(X).Top & " and " & ActiveSheet.Shapes(X).Left & vbCrLf & _
            "Visibility: " & IIf(ActiveSheet.Shapes(X).Visible = msoFalse, "Not Visible", "Visible")
        Else
              
'Do this for everything that is not a msoComment or msoFormControl
        MsgBox "Object Type: " & objType(ActiveSheet.Shapes(X).Type) & " (Type # " & ActiveSheet.Shapes(X).Type & ")" & vbCrLf & _
        "Name: " & ActiveSheet.Shapes(X).Name & vbCrLf & _
        "Location (between (at)): " & ActiveSheet.Shapes(X).TopLeftCell.Address & " & " & ActiveSheet.Shapes(X).BottomRightCell.Address & vbCrLf & _
        "Visibility: " & IIf(ActiveSheet.Shapes(X).Visible = msoFalse, "Not Visible", "Visible")
    End If
        
End If
Next X
End If

'msoComment section
    Dim rngComments As Range
            Dim Rng As Range
            Dim strMergeArea As String

            On Error Resume Next
            Set rngComments = ActiveSheet.Cells.SpecialCells(xlCellTypeComments)
            On Error GoTo 0

            If Not rngComments Is Nothing Then
                    For Each Rng In rngComments
                        If Rng.MergeCells Then
                            If Rng.MergeArea.Address <> strMergeArea Then
                                MsgBox "Object Type: MERGED Comment Box (Type #17)" & vbCrLf & _
                                "Name: " & Rng.MergeArea.Cells(1).Comment.Shape.Name & vbCrLf & _
                                "Location (between (at)): " & Rng.MergeArea.Address & " between/at " & Rng.MergeArea.Cells(1).Comment.Shape.TopLeftCell.Address & " & " & Rng.MergeArea.Cells(1).Comment.Shape.BottomRightCell.Address & vbCrLf & _
                                "Visibility: " & IIf(Rng.MergeArea.Cells(1).Comment.Visible = msoFalse, "Not Visible", "Visible")
                                strMergeArea = Rng.MergeArea.Address
                            End If
                        Else
                        MsgBox "Object Type: Comment Box (Type #17)" & vbCrLf & _
                                "Name: " & Rng.Comment.Shape.Name & vbCrLf & _
                                "Location (between (at)): " & Rng.Address & vbCrLf & _
                                "Visibility: " & IIf(Rng.Comment.Visible = msoFalse, "Not Visible", "Visible")
                        End If
                    Next Rng
            End If
'End comment section

End Sub