Excel VBA - Delete Shapes in a Range

R

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

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
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
You must log in or register to reply here.

Similar threads

drom
  • Question Question
Avoid deleting Drop Down shapes contained in cells validation lists
Replies
0
Views
229
drom
drom
M
  • Solved
Deleting all shapes in all selected cells
Replies
1
Views
484
Mesh
M
M
  • Question Question
Please help me to correct Excel VBA code!
Replies
1
Views
351
Minh Tuan VN
M
D
  • Question Question
Copying/Pasting images to the correct row/column location between two different workbooks
Replies
0
Views
384
doctorhifi
D
R
  • Solved
Images Won't Delete
Replies
5
Views
394
rodl66
R

Forum statistics

Threads
1,224,596
Messages
6,179,807
Members
452,944
Latest member
2558216095

Share this page

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