Delete pictures in specific rows

cacahuatitaCH

New Member
Joined
Jan 8, 2021
Messages
12
Office Version
  1. 365
Platform
  1. Windows
I have been trying to delete ONLY the pictures (and ideally, the added shapes) in a worksheet using this code I found in another thread here:

VBA Code:
Sub DeletePic()
Set ws = ActiveSheet

Set Rng = ws.Range("A5:F500")

For Each pic In ActiveSheet.Pictures
    With pic
        s = .TopLeftCell.Address & ":" & .BottomRightCell.Address
    End With
    If Not Intersect(Rng, ws.Range(s)) Is Nothing Then
        pic.Delete
    End If
Next

End Sub

The problem is that this code deletes all pictures, but leaves the shapes, AND also deletes checkboxes (ActiveX control)

What I need is an alternative code that deletes pictures and shapes ONLY in the specified range.

I kept thinking I could substitute the range for row numbers, but I have no been able to make the necessary adjustment by myself.
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
To delete only the pictures in the specified range try this:
VBA Code:
Sub DeletePics()
Dim shp As Shape
Set ws = ActiveSheet
Set Rng = ws.Range("A5:F500")
Application.ScreenUpdating = False
For Each shp In ws.Shapes
    With shp
        If .Name Like "Picture*" Then
            s = .TopLeftCell.Address & ":" & .BottomRightCell.Address
            If Not Intersect(Rng, ws.Range(s)) Is Nothing Then
                shp.Delete
            End If
        End If
    End With
Next
Application.ScreenUpdating = True
End Sub
To delete only pictures and shapes try this:
VBA Code:
Sub DeletePicsAndShapes()
Dim shp As Shape
Set ws = ActiveSheet
Set Rng = ws.Range("A5:F500")
Application.ScreenUpdating = False
For Each shp In ws.Shapes
    With shp
        If .Name Like "CheckBox*" Then GoTo Nxt
        s = .TopLeftCell.Address & ":" & .BottomRightCell.Address
        If Not Intersect(Rng, ws.Range(s)) Is Nothing Then
            shp.Delete
        End If
    End With
Nxt: Next shp
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,538
Messages
6,114,220
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top