No question here, just an example procedure for the archive.

Create a worksheet report for all Shapes found on the active worksheet.
The report shows the Shape names and top left corner cell locations for
the active worksheet

Sub ShapesReportForActiveSheet()

' Creates a worksheet report for all shape names and locations
'for the active worksheet

Dim ShapeCells As Range
Dim TargetSheet, ShapeSheet As Worksheet
Dim Row As Integer
Set TargetSheet = ActiveSheet

On Error Resume Next
''Check for presence of any shapes on active worksheet
If ActiveSheet.Shapes.Count = 0 Then
MsgBox "There are no Shapes present on this worksheet"
Exit Sub
End If

' If Shapes present, then identify location(s) of top left corner
of each Shape.
' and proceed with report

For Each sh In ActiveSheet.Shapes

If ShapeCells Is Nothing Then
Set ShapeCells = sh.TopLeftCell
Else
Set ShapeCells = Union(sh.TopLeftCell, ShapeCells)
End If

Next

'Add the report worksheet

Application.ScreenUpdating = False

Set ShapeSheet = ActiveWorkbook.Worksheets.Add
ShapeSheet.Name = "Location of Shapes in " & ShapeCells.Parent.Name

'Set up the column headings
With ShapeSheet

Range("A1") = "Shape Name"
Range("B1") = "Top Left Cell Address"
Range("A1:B1").Font.Bold = True

End With

TargetSheet.Activate

'Process each shape

Row = 2

For Each sh In ActiveSheet.Shapes

Application.StatusBar = Format((Row - 1) / ShapeCells.Count,
"0%")

ShapeSheet.Cells(Row, 1) = sh.Name
ShapeSheet.Cells(Row, 2) = sh.TopLeftCell.Address

Row = Row + 1

Next

'Adjust column widths
ShapeSheet.Columns("A:B").AutoFit
Application.StatusBar = False

ShapeSheet.Activate

Range("A2").Select

End Sub

Search criteria:
Shapes report return shape locations return shape names get shape names