Excel VBA ошибка 1004 при попытке удалить кнопки из диапазона ячеек

Question

У меня возникли проблемы с удалением диапазона ячеек, в которых содержатся командные кнопки ActiveX, поскольку приведенный ниже код выдаст ошибку 1004 «Ошибка приложения или объекта» в части пересечения при отладке.

Sub DeleteShapes() 
    Dim rng As Range
    Dim sh As Shape
    Set rng = Range("I7:K61")

    With Sheets("ADB")
        For Each sh In .Shapes    
            If Not Intersect(sh.TopLeftCell, .Range(rng)) Is Nothing Then
                sh.Delete
            End If
        Next
    End With
End Sub

Лист не заблокирован, и я позаботился о том, чтобы все ячейки в диапазонах также не были заблокированы. Слитых ячеек тоже нет. Я пробовал другие комбинации кодов, но это все равно приводит к ошибке 1004. Код находится в модуле.

Странно, если я добавляю код, чтобы игнорировать ошибку, он удаляет кнопки без проблем. Однако возникла странная проблема, из-за которой после удаления кнопок раскрывающийся список с проверками данных не отображается. Единственный способ показать это - сохранить рабочую книгу. Удаление кнопок после сохранения снова приводит к исчезновению выпадающего списка.

Какие-нибудь решения для этого?

РЕДАКТИРОВАТЬ: Похоже, что я испытываю какой-то объект "Призрачный выпадающий" с типом 8 на основе кода VBasic2008. Я создал новый лист и попытался скопировать некоторые из старых, затем он снова сохранился. Дальнейшие эксперименты показывают, что это происходит из моих ячеек проверки данных. Тем не менее, как ни странно, удаление проверки данных не удаляет выпадающий объект. Очистка всего листа приводит к тому, что объект все еще сохраняется. Мне пришлось удалить лист, чтобы избавиться от него ..

Проверка данных считается контролем формы? Это не должно быть .. верно?

РЕДАКТИРОВАТЬ: Как я генерирую свои кнопки

Public Sub GenerateButtons()
 Dim i As Long
 Dim shp As Object
 Dim ILeft As Double
 Dim dblTop As Double
 Dim dblWidth As Double
 Dim dblHeight As Double
 Dim lrow As Long

 lrow = Cells(Rows.count, 1).End(xlUp).Row

 With Sheets("ADB")
     ILeft = .Columns("I:I").Left      
     dblWidth = .Columns("I:I").Width    
     For i = 7 To lrow                      
         dblHeight = .Rows(i).Height     
         dblTop = .Rows(i).Top         
         Set shp = .Buttons.Add(ILeft, dblTop, dblWidth, dblHeight)
         shp.OnAction = "Copy1st"
         shp.Characters.Text = "Copy " & .Cells(i, 6).Value
     Next i
 End With

 End Sub

Answer 1

Форма

В браузере объектов VBE найдите msoShapeType, и вы заметите, что Есть несколько типов форм. В вашем случае, вероятно:

msoFormControl (8) - выпадающие списки
msoOLEControlObject (12) - кнопки и прочее.

В любом случае сначала попробуйте этот код, чтобы определить, что вы хотите удалить.

Sub ShapeTypes()

  Dim shshape As Shape

  Const c1 = " , "
  Const r1 = vbCr
  Dim str1 As String

  str1 = "Shape Types in ActiveSheet"
  For Each shshape In ActiveSheet.Shapes
    str1 = str1 & r1 & Space(1) & shshape.Name & c1 & shshape.Type
  Next
  Debug.Print str1

End Sub

Следующий код удаляет все типизированные фигуры msoOLEControlObject в ActiveSheet (который, я предполагаю, вы хотите удалить):

Sub ShapesDelete()

  Dim shshape As Shape

  For Each shshape In ActiveSheet.Shapes
    If shshape.Type = 12 Then
      shshape.Delete
    End If
  Next

End Sub

Наконец твой код:

Sub DeleteShapes()

    Const cStrRange As String = "I7:K61"
    Const cStrSheet As String = "ADB"

    Dim sh As Shape

    With Sheets(cStrSheet)
        For Each sh In .Shapes
            If sh.Type = 12 Then 'or msoOLEControlObject
                On Error Resume Next
                If Intersect(sh.TopLeftCell, .Range(cStrRange)) Then
                    If Not Err Then
                        sh.Delete
                    End If
                End If
            End If
        Next
    End With

End Sub

Я до сих пор не выяснил причину ошибки, но она обрабатывается и все кнопки удаляются.

Новая версия:

Sub DeleteShapes()

    Const cStrRange As String = "I7:K61"
    Const cStrSheet As String = "ADB"

    Dim sh As Shape

    With Sheets(cStrSheet)
        For Each sh In .Shapes
            If sh.Type = 8 Then 'or msoFormControl
                On Error Resume Next
                If Not Intersect(sh.TopLeftCell, .Range(cStrRange)) Is Nothing Then
                    If Left(sh.Name,4) = "Butt" then  
                        sh.Delete
                    End If
                End If
            End If
        Next
    End With

End Sub

Нет необходимости в обработке ошибок, поскольку НЕПРАВИЛЬНАЯ строка перехвата вызывала ошибку.