Private Sub cmdDeleteAll_Click()
Dim sh As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
For Each sh In Application.ActiveWorkbook.Sheets
    If sh.Shapes.Count >  0  Then
        sh.Select
        sh.Shapes.SelectAll
        If Not (Selection Is Range("A1")) Then
            Selection.Delete
        End If
    End If
Next sh
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sub Удалить_все_стили_и_имена()
    Dim st As Style
    Dim kol_stiley

    With ActiveWorkbook

        kol_stiley = .Styles.Count
        MsgBox "Всего стилей в документе = " & kol_stiley & Chr( 10 ) & " Для успешного удаления стилей нужно снять защиту 
на всех листах.", vbInformation

        On Error Resume Next
        For Each st In .Styles
            If st.Name <> "Normal" Then
                st.Delete
            End If
        Next st

        MsgBox "Было удалено " & kol_stiley - .Styles.Count & " стилей, осталось " & .Styles.Count & " стилей", 
vbInformation
    End With

    Dim n As Name, ns As Names, nCoumt As Long, i As Long

    Set ns = ActiveWorkbook.Names
    nCoumt = ns.Count
    MsgBox "Всего имен в документе = " & CStr(nCoumt) & Chr( 10 )

    For i =  1  To nCoumt
        ns.Item( 1 ).Delete
    Next i
    On Error GoTo  0 
End Sub