Хотите очистить фигуры в определенном диапазоне, но есть ошибка приложения

Question

В основном я делаю код, в котором он будет отображать формы в соответствии с определенной переменной. Однако, как только эта переменная изменится, появится «Ошибка времени выполнения« 1004 »: ошибка приложения или объекта». Я хотел создать модуль для назначения макроса кнопке; Хотите очистить фигуры в определенном диапазоне, но есть ошибка. Однако после сброса и отладки модуля он работает нормально. Несмотря на это, проблема возникает снова при изменении определенной переменной.

Sub ClearingofButton()
Dim pic As Picture
Dim shp As Shape

ActiveSheet.Unprotect

If Sheets("Calculator").Range("AU64").Formula = "5" Then
    If ActiveSheet.Shapes.Count > 0 Then
    For Each shp In Sheets("Calculator").Shapes
    Application.EnableCancelKey = xlDisabled
        If Not Application.Intersect(shp.TopLeftCell, ActiveSheet.Range("Illustration")) Is Nothing Then
            shp.Delete
    Application.EnableCancelKey = xlInterrupt
        End If

    Next shp

    End If
End If

If Sheets("Calculator").Range("AU64").Formula = "10" Then
    If ActiveSheet.Shapes.Count > 0 Then
    For Each shp In Sheets("Calculator").Shapes
    Application.EnableCancelKey = xlDisabled
        If Not Application.Intersect(shp.TopLeftCell, ActiveSheet.Range("Illustration")) Is Nothing Then
            shp.Delete
    Application.EnableCancelKey = xlInterrupt
        End If

    Next shp

    End If
End If

If Sheets("Calculator").Range("AU64").Formula = "19" Then
    If ActiveSheet.Shapes.Count > 0 Then
    For Each shp In Sheets("Calculator").Shapes
    Application.EnableCancelKey = xlDisabled
        If Not Application.Intersect(shp.TopLeftCell, ActiveSheet.Range("Illustration")) Is Nothing Then
            shp.Delete
    Application.EnableCancelKey = xlInterrupt
        End If

    Next shp

    End If
End If

If Sheets("Calculator").Range("AU64").Formula = "30" Then
    If ActiveSheet.Shapes.Count > 0 Then
    For Each shp In Sheets("Calculator").Shapes
    Application.EnableCancelKey = xlDisabled
        If Not Application.Intersect(shp.TopLeftCell, ActiveSheet.Range("Illustration")) Is Nothing Then
            shp.Delete
    Application.EnableCancelKey = xlInterrupt
        End If

    Next shp

    End If
End If

If Sheets("Calculator").Range("AU64").Formula = "40" Then
    If ActiveSheet.Shapes.Count > 0 Then
    For Each shp In Sheets("Calculator").Shapes
    Application.EnableCancelKey = xlDisabled
        If Not Application.Intersect(shp.TopLeftCell, ActiveSheet.Range("Illustration")) Is Nothing Then
            shp.Delete
    Application.EnableCancelKey = xlInterrupt
        End If

    Next shp

    End If
End If

End Sub

Answer 1

Пожалуйста, попробуйте этот код и посмотрите, вызывает ли он ту же проблему.

Sub ClearingOfButton()

    Dim Ws As Worksheet
    Dim Shp As Shape
    Dim Tmp As Variant

    Set Ws = ActiveSheet
    If Ws.Shapes.Count Then
        Ws.Unprotect
        Tmp = Sheets("Calculator").Range("AU64").Value

        If (Tmp = 5) Or (Tmp = 10) Or (Tmp = 19) Or (Tmp = 30) Or (Tmp = 40) Then
            For Each Shp In Sheets("Calculator").Shapes
                If Not Application.Intersect(Shp.TopLeftCell, _
                                             Ws.Range("Illustration")) Is Nothing Then
                    Shp.Delete
                End If
            Next Shp
        End If
    End If
End Sub

Если это так, добавьте строку On Error Resume Next перед Shp.Delete и исследуйте фигуру, которая не удаляется, хотя ты ожидал этого.