One way:

Public Sub GetShapes()
Dim vShape As Variant
Dim i As Long
With ActiveSheet.Shapes
If .Count 0 Then
ReDim vShape(1 To .Count, 1 To 5)
For i = 1 To .Count
vShape(i, 1) = .Item(i).Name
vShape(i, 2) = .Item(i).Top
vShape(i, 3) = .Item(i).Left
vShape(i, 4) = .Item(i).Height
vShape(i, 5) = .Item(i).Width
Next i
.Parent.Range("A1").Resize(1, 5) = _
Array("Name", "Top", "Left", "Height", "Width")
.Parent.Range("A2").Resize(.Count, 5).Value = vShape
End If
End With
End Sub




In article ,
famdamly wrote:

How can I get the name, size and position coordinates of all the objects
in an area (such as the screen) to be entered into a list.
For example let's say we drew 4 shapes. A square, a circle a triangle
and a rectangle. Then let's say I moved these objects around on the
screen, resized the triangle and cut the circle.

Now I need a macro that will identify the names of the shapes that are
left on the screen and give me the sizes of each shape and their
location.