Excel VBA - Delete Shapes in a Range

[rick6823]

Hello;

I have an Excel application I'm using to import product images and allow the user to supply information about their products. After selecting images to insert, I'm using this code to insert filenames and thumbnails:

For f = 1 To UBound(files)
.[b65536].End(3)(2) = files(f)
.Range("C" & .[b65536].End(3).Row).Select
Selection.EntireRow.RowHeight = 36
With ActiveSheet.Pictures.Insert(files(f))
.ShapeRange.Height = 36
.Name = Right(files(f), Len(files(f)) - InStrRev(files(f), "\"))

I have a command button on the page to clear (reset) the sheet; but, I don't want to clear all images...just the images that were imported.

I'm using the following code which still seems to delete every image:

For Each shp In ActiveSheet.Shapes
If shp.Name <> "Picture2" Then shp.Delete
Next

Can anyone tell me how to code it so I only delete shapes imported in the above range? Thanks In Advance!

 

[Ekim]

Rick,

The reason why your code is deleting all pictures is because the code refers to the ActiveSheet.

For Each shp In ActiveSheet.Shapes
If shp.Name <> "Picture2" Then shp.Delete
Next

Try this (deletes all pictures in the range C1:C50):

Sub Test()
Dim Sh As Shape
With Worksheets("Sheet1")
   For Each Sh In .Shapes
       If Not Application.Intersect(Sh.TopLeftCell, .Range("C1:C50")) Is Nothing Then
         If Sh.Type = msoPicture Then Sh.Delete
       End If
    Next Sh
End With
End Sub

HTH

Mike

 

[Ekim]

Rick,

Just noted, in your macro snippet you do not want to delete Picture 2. Change the previous macro to:

Sub Test()
Dim Sh As Shape
With Worksheets("Sheet1")
   For Each Sh In .Shapes
       If Not Application.Intersect(Sh.TopLeftCell, .Range("A1:A50")) Is Nothing Then
         If Sh.Name <> "Picture 2" And Sh.Type = msoPicture Then Sh.Delete
       End If
    Next Sh
End With
End Sub

Regards,

Mike

 

[rick6823]

Thank you Mike! Works like a charm. Thanks very much for your time.

 

[cherrox]

help
It works for me as an isolated Sub, but i have my code like this:

...
Select Case usu
Case Hoja7.Range("B23").Value
If pass = pass1 Then
Sheets("Sec Data").Select
Range("E24").Select
Selection.Copy
Sheets("Summary").Select
Range("F6").Select
ActiveSheet.Paste
Else
'f6
Sheets("Summary").Select
With ActiveSheet
If ActiveSheet.Shapes.Count > 0 Then
For Each Sh In .Shapes
If Not Application.Intersect(Sh.TopLeftCell, .Range("F6")) Is Nothing Then
If Sh.Type = msoPicture Then
Sh.Delete
End If
End If
Next Sh
End If
End With
'Sheet1.Range("F6").Value = "Incorrecto"
End If
...more cases

It gives the 1004 Error "defined by the application or object"
If I debug, the line:
If Not Application.Intersect(Sh.TopLeftCell, .Range("F6")) Is Nothing Then
turns yellow..
please, help