Problem with deleting pictures in range with VBA-CodePudding

I need to delete all pictures what are in defined range. Originaly I tried to use:

Dim OBR as Picture
For Each OBR In ActiveSheet.Pictures
If Not Intersect(OBR.TopLeftCell, Range("B2:B7")) Is Nothing Then
OBR.Delete
End If
Next OBR

Unfortunately it is not working - code stops on For Each OBR In ActiveSheet.Pictures with no hint why.

I also tried code I found here on forum:

    Dim xPicRg As Range
    Dim xpic As Picture
    Dim xRg As Range
    
    Set xRg = Range("B2:B7")
    For Each xpic In ActiveSheet.Pictures
        Set xPicRg = Range(xpic.TopLeftCell.Address & ":" & xpic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xpic.Delete
    Next

Same issue. On sheet there are 8 pictures (and cca 10 shapes), which only 6 pictures are supposed to be deleted. ActiveSheet.Pictures.count gives me right value 8. When it was not working with range I also tried something like this:

    For i = 1 To ActiveSheet.Pictures.count

    If Not ActiveSheet.Pictures(i).Name = ob100 Or ActiveSheet.Pictures(i).Name = ob125 Then
    ActiveSheet.Pictures(i).Delete
    Else
    End If
Next i

But it is not working also, so Im very stucked. Please any help why the first macro is not working?

The ob100 and ob125 what excel counts as pictures are acctually checkboxes and the rest are inserted pictures.

Thank you for any help.

CodePudding user response：

Try code below. You'll probably need to change the sheet name in the code.

Sub Test()

    Dim OBR As Shape
    For Each OBR In ThisWorkbook.Worksheets("Sheet1").Shapes
        If OBR.Type = msoPicture Then
            If Not Intersect(OBR.TopLeftCell, ThisWorkbook.Worksheets("Sheet1").Range("B2:B7")) Is Nothing Then
                OBR.Delete
            End If
        End If
    Next OBR

End Sub