Удаление изображений, но не может избежать удаления кнопки команды

Question

Я не обычный пользователь vba, поэтому, когда я начал делать этот код, я был совершенно пустым. Я уже удалил все изображения на листе, включая кнопки команд и логотип, который не хотел удалять.

Это мой код

Private Sub CommandButton2_Click()

Dim Pic As Object

Range("D20:D3000").ClearContents

For Each Pic In ActiveSheet.Pictures
Pic.Delete
Next Pic


End Sub

Как видите, мне нужно удалить изображения в столбце D, но он удаляет изображения всего листа. Я не могу найти способ исключить командные кнопки (я использую 2 на этом листе) из инструкции по удалению. Некоторые из вас, пожалуйста, пожалуйста, пожалуйста, помогите мне? Я сейчас в беспорядке.

Answer 1

Мне нужно, чтобы удалить изображения в столбце D, но он удаляет изображения всего листа.

Вы перебираете все изображения на листе и никогда не проверяете где на листе изображение находится перед тем, как вы вызываете его метод Delete.

Интересно, что если у вас есть одно изображение и одна кнопка ActiveX на Sheet1, то Sheet1.Pictures.Count возвращает,неожиданно, 2 - именно поэтому цикл также удаляет командные кнопки.

Я бы предложил вместо этого выполнить итерацию коллекции Shapes: у объекта Shape есть интерфейс, который значительно упрощает определениеизображение, кроме кнопки ActiveX, ... и узнать, где на листе он находится.

Используя Shape.Type, мы можем узнать, смотрим ли мы на msoPicture, а с Shape.TopLeftCell мыможет получить объект Range, представляющий верхнюю левую ячейку, в которой находится изображение;если Column этого Range равно 4, то мы смотрим на фигуру, левый верхний угол которой находится в столбце D. Таким образом:

Dim currentShape As Shape
For Each currentShape In ActiveSheet.Shapes
    If currentShape.Type = msoPicture And currentShape.TopLeftCell.Column = 4 Then
        currentShape.Delete
    End If
Next

Обратите внимание, как объявлять явноетип, который не Object для нашей переменной цикла, мы получаем проверку во время компиляции и autocomplete / intellisense для каждого из этих вызовов членов, тогда как вызовы, сделанные против Object, имеют позднюю привязку (то есть компилируются прекраснос опечатками, даже если у вас есть Option Explicit в верхней части вашего модуля) и будет взорван только во время выполнения, если что-то не так (например, ошибка 438, если вы пытаетесь вызвать элемент, который не существует).

Answer 2

Ниже сравнивается диапазон изображения с вашим диапазоном и удаляется, если они пересекаются:

Private Sub CommandButton2_Click()
    Dim objPicture As Object
    Dim objPictureRange As Object
    Dim objRange As Object

    Set objRange = Range("D20:D3000")
    objRange.ClearContents

    For Each objPicture In ActiveSheet.Pictures

        ' Get Picture's range
        Set objPictureRange = Range(objPicture.TopLeftCell.Address & ":" & objPicture.BottomRightCell.Address)

        ' Check if Picture is in Range
        If Not Intersect(objRange, objPictureRange) Is Nothing Then
            ' Delete picture
            objPicture.Delete
        End If

    Next Pic

End Sub