Delete photos from multiple worksheets within ranges using vba?

[wai yan]

Sub SelectAllPicturesInSelectedRange()


Dim oShape As shape
Dim rUserSel As Range

Sheet6.Range("E24:W204,AI1:BA204").Select


If TypeName(Selection) <> "Range" Then Exit Sub

Set rUserSel = Selection

For Each oShape In Sheet6.Shapes
If oShape.Type = msoPicture Then
If Not Intersect(oShape.TopLeftCell, rUserSel) Is Nothing Then
oShape.Select False
End If
End If
Next oShape

For Each oShape In Sheet7.Shapes
If oShape.Type = msoPicture Then
If Not Intersect(oShape.TopLeftCell, rUserSel) Is Nothing Then
oShape.Select False
End If
End If
Next oShape

End Sub

 

[DanteAmor]

To select the object, you must first select the sheet.
To delete the object, change this: "oShape.Select False" for this: "oShape.Delete"

Sub SelectAllPicturesInSelectedRange()
    Dim oShape As Shape
    Dim rUserSel As Range
    
[COLOR=#0000ff]    Sheet6.Select[/COLOR]
[COLOR=#0000ff]    Set rUserSel = Range("E24:W204,AI1:BA204")[/COLOR]
    For Each oShape In Sheet6.Shapes
        If oShape.Type = msoPicture Then
            If Not Intersect(oShape.TopLeftCell, rUserSel) Is Nothing Then
                oShape.Select False
            End If
        End If
    Next oShape
        
[COLOR=#0000ff]    Sheet7.Select[/COLOR]
[COLOR=#0000ff]    Set rUserSel = Range("E24:W204,AI1:BA204")[/COLOR]
    Set oShape = Nothing
    For Each oShape In Sheet7.Shapes
        If oShape.Type = msoPicture Then
            If Not Intersect(oShape.TopLeftCell, rUserSel) Is Nothing Then
                oShape.Select False
            End If
        End If
    Next oShape
End Sub

 

[wai yan]

To select the object, you must first select the sheet.
To delete the object, change this: "oShape.Select False" for this: "oShape.Delete"

Sub SelectAllPicturesInSelectedRange()
    Dim oShape As Shape
    Dim rUserSel As Range
    
[COLOR=#0000ff]    Sheet6.Select[/COLOR]
[COLOR=#0000ff]    Set rUserSel = Range("E24:W204,AI1:BA204")[/COLOR]
    For Each oShape In Sheet6.Shapes
        If oShape.Type = msoPicture Then
            If Not Intersect(oShape.TopLeftCell, rUserSel) Is Nothing Then
                oShape.Select False
            End If
        End If
    Next oShape
        
[COLOR=#0000ff]    Sheet7.Select[/COLOR]
[COLOR=#0000ff]    Set rUserSel = Range("E24:W204,AI1:BA204")[/COLOR]
    Set oShape = Nothing
    For Each oShape In Sheet7.Shapes
        If oShape.Type = msoPicture Then
            If Not Intersect(oShape.TopLeftCell, rUserSel) Is Nothing Then
                oShape.Select False
            End If
        End If
    Next oShape
End Sub

It is perfectly work bro. I really aprreciate for it. !!!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.