时间戳

首页 > 解决方案 > 想清除一定范围内的形状但出现应用错误

excel - 想清除一定范围内的形状但出现应用错误

问题描述

基本上我正在做一个代码，它会根据某个变量显示形状。但是，一旦某个变量发生变化，就会出现“运行时错误'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

标签： excelvbaruntime-errorshapes

解决方案

请尝试此代码，看看它是否会引发相同的问题。

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并调查未删除的形状，尽管您希望它会删除。

推荐阅读