Excel VBA - Delete Shapes in a Range

rick6823

New Member
Joined
Mar 5, 2004
Messages
11
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!
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
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):
Code:
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
 
Upvote 0
Rick,

Just noted, in your macro snippet you do not want to delete Picture 2. Change the previous macro to:
Code:
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
 
Upvote 0
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 :(
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,198
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