Deleting an ambiguous shape name

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hello:

I am trying to write/record a macro that will clear out a worksheet in
specific ranges. It is easy to deal with the text portions, but the worksheet
also contains a picture that also needs to be deleted, but the picture is
different each week and always has a different name. Is there a way to select
a shape if I can't pinpoint the name value?
Thanks.
 
If you want to get rid of all

Sub ShapesCut()
For Each s In ActiveSheet.Shapes
s.Cut
Next
End Sub
 
Joel:

That works great except I failed to mention I also have two graphs on the
same sheet that I DO NOT want deleted (which your macro does), is there a way
around that caveat?
 
For Each shp In ActiveSheet.Shapes
If shp.Type <> msoChart Then
shp.Delete
End If
Next shp
 
Hello
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Type = msoPicture Then sh.Delete
Next sh

HTH
Cordially
Pascal
 
That does the job perfectly, thank you!

papou said:
Hello
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Type = msoPicture Then sh.Delete
Next sh

HTH
Cordially
Pascal
Click to expand...
 
Careful, this will delete DV and autofilter arrows as well


'----------------------------------------------------------------
Sub RemoveShapes()
'----------------------------------------------------------------
' Written by : Bob Phillips
' Inspired by: Debra Dalgleish & Dave Peterson
' Improved by: Dave Peterson (cater for forms combobox)
'---------------------------------------------------------------
' Synopsis: Checks each shape to be form control, and if it
' is a dropdown, it aims to retain it.
' One problem is taht the forms combobox which is
' also a form control, and is a dropdown, so it
' does not get deleted.
'
' Catered for by testing top left of shape, as
' Autofilter and Data Validation dropdowns do not
' seem to have a topleftcell address.
'---------------------------------------------------------------
Dim shp As Shape
Dim sTopLeft As String
Dim fOK As Boolean

For Each shp In ActiveSheet.Shapes

fOK = True

sTopLeft = ""
On Error Resume Next
sTopLeft = shp.TopLeftCell.Address
On Error GoTo 0

If shp.Type = msoChart Then
fOK = False
ElseIf shp.Type = msoFormControl Then
If shp.FormControlType = xlDropDown Then
If sTopLeft = "" Then
fOK = False 'keep it
End If
End If
End If

If fOK Then
shp.Delete
End If

Next shp

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
That is an awesome solution. Is there a way that could be done in just one
range of the worksheet? (I didn't realize I was deleting another picture I
didn't want deleted.)
 
You will need to check each object individually to see if it's in the range
you want to keep. Following should delete all pictures except any that is
entirely or partly within columns C:E

Sub test()
Dim rngKeep As Range
Dim pic As Picture

Set rngKeep = ActiveSheet.Range("C:E")

For Each pic In ActiveSheet.Pictures
If Intersect(ActiveSheet.Range(d.TopLeftCell, d.BottomRightCell), rngKeep)
Is Nothing Then
pic.Delete
End If

Next

End Sub

Might be worth naming any pictures you know you will want to keep, eg

if instr(1, pic.name "keep") = 0 then pic.delete

Regards,
Peter T
 
Nope.

But you could loop through all the pictures and look at the .topleftcell and see
if it's in the range to be saved or deleted.

Dim myPict as Picture
dim RngToSave as Range

with activesheet
set rngtosave = .range("b1:c99")
for each mypict in .pictures
if intersect(mypict.topleftcell, rngtosave) is nothing then
'not in the range so it's ok to delete
mypict.delete
end if
next mypict
end with

Untested, uncompiled. Watch for typos.
 
Got this from this forum.
Allows you to choose whihc ones to delete.

Sub DelShapesOnSht()
Dim shp As Shape
Dim ans
For Each shp In ActiveWorkbook.ActiveSheet.Shapes
ans = MsgBox("DELETE Shape" & Chr(10) & shp.Name & " " _
& shp.TopLeftCell.Address & Chr(10) & " -- " _
& shp.AlternativeText, vbYesNoCancel + vbDefaultButton2)
If ans = 2 Then
shp.Select 'Select shape and exit
Exit Sub
End If
If ans = 6 Then shp.Delete 'Delete the shape
Next shp
End Sub
 
Back
Top