Thank you for sharing the file. Obviously, you already have a solution. My interest was more for my own curiosity and education.
I took the liberty of plagiarising the code you have been given and carrying out some diagnostics. It wasn't as informative as I'd hoped, but I listed out all the shapes together with some of their properties. The only one that proved useful was the Type. Type 13 is for Pictures and Type 1 is for AutoShapes. Given the requirement, you could adapt the code to delete Shapes with a Type 1.
Some statistics:
All 5095
image 267
imagen 2
Picture 9
AutoShapes 4817
AutoShape 1 656
AutoShape 3 699
AutoShape 4 2860
AutoShape 6 602
Type 13 11
The modified code. Note that the deletion element is blocked as I wasn't interested in deleting the shapes.
Option Explicit
Sub removeshapes()
Dim ws As Worksheet: Set ws = Sheets("Xtreme")
Dim shp As Shape
Dim shpCount As Long
If MsgBox("Sheet " & ws.Name & " contains " & ws.Shapes.Count & " shapes." & vbNewLine & "Delete hidden?", vbYesNo) = vbNo Then Exit Sub
Dim lShpCount As Long: lShpCount = ws.Shapes.Count
Dim vArray, i As Long
ReDim vArray(1 To lShpCount, 1 To 9)
For Each shp In ws.Shapes
i = i + 1
vArray(i, 1) = i
vArray(i, 2) = shp.Name
If shp.Visible = msoTrue Then vArray(i, 3) = "visible"
vArray(i, 4) = shp.Height
vArray(i, 5) = shp.Width
vArray(i, 6) = shp.Type
On Error Resume Next
vArray(i, 7) = shp.Top
vArray(i, 8) = shp.Left
vArray(i, 9) = shp.ID
On Error GoTo 0
shp.Visible = True
Next
Sheets("List").Range("A2").Resize(UBound(vArray, 1), UBound(vArray, 2)) = vArray
Stop
Exit Sub
For Each shp In ws.Shapes
If Not UCase(shp.Name) Like "PICTURE*" And Not UCase(shp.Name) Like "IMAGEN*" Then
shpCount = shpCount + 1
'shp.Delete
End If
DoEvents
Next
MsgBox "Deleted " & shpCount & " shapes." & vbNewLine & ws.Shapes.Count & " shapes remain."
End Sub
Bookmarks