Remove an inserted picture

[Patrick C. Simonds]

The code below inserts picture if a condition is met. My question is, is
there any way to remove the picture if the condition no longer exists?


Sub InsertHoliday()
Dim myPict As Picture
Dim rng

On Error GoTo Error


If range("B58").Value <> "" Then
Set rng = range("B18")
End If

If range("C58").Value <> "" Then
Set rng = range("C18")
End If

If range("D58").Value <> "" Then
Set rng = range("G18")
End If


If range("F1") = "No Picture" Then GoTo NoPicture


With rng
Set myPict = .Parent.Pictures.Insert("C:\Users\Owner\Desktop\New
Years Large.gif")
myPict.Top = .Top
myPict.Left = .Left
End With

Error:

End Sub

 

[Peter T]

Give the Picture a unique name when you insert it

With rng
Set myPict = .Parent.Pictures.Insert( etc
myPict.Name = "myPic"

If the condition requires it be deleted

On Error Resume next
Activesheet.Pictures("myPic").delete ' could use .Shapes("myPic").Delete
On error goto 0 ' or resume normal error handling

(looks like you are dealing with the activesheet)

Regards,
Peter T

 

[Dave Peterson]

Just to add to Peter's suggestion...

I like to use the address of the topleftcorner of the cell in the name if I know
I'm going to manipulate the picture based on its location.

with myPict
.name = "Pic_" & .topleftcell.address(0,0)
end with

Or if it uses some other criteria, give it a name that includes that criteria.

 

[Patrick C. Simonds]

Is there any way to deleted the picture without knowing what sheet it is on?
The workbook has 108 worksheets and the picture could be on any one of those
sheets.

 

[Peter T]

Obviously no direct way without knowing which sheet it's on, you'd need to
loop each sheet until you found it.

It all seems rather strange but if you inserted the picture in the first
place why not do something like this

' with the insert code

myPict.topleftcell.name = "myPic"

then when you want to delete it

Dim nm As Name
On Error Resume Next
Set nm = Nothing
Set nm = ActiveWorkbook.Names("myPic")
On Error GoTo 0
If Not nm Is Nothing Then
nm.RefersToRange.Parent.Shapes("myPic").Delete
nm.Delete
Else
'
End If

Regards,
Peter T

 

[Patrick C. Simonds]

I tried coming up with a routine which would run through each worksheet but
it it errors out if the picture does not exist on the page.



Application.ScreenUpdating = True
Application.EnableEvents = False

Dim n As Single
For n = 1 To Sheets.Count
With Sheets(n)
ActiveSheet.Pictures("Auto").Delete
End With
Next n

Application.EnableEvents = True
Application.ScreenUpdating = True

 

[Dave Peterson]

You could check first.

Dim n As long
Dim myPict as Picture

For n = 1 To Sheets.Count
With Sheets(n)
set mypict = nothing
on error resume next
set mypict = .Pictures("Auto")
on error goto 0

if mypict is nothing then
'not on this sheet
else
mypict.delete
'exit for 'stop looking on other sheets??????
end if
End With
Next n

 

[Peter T]

Yet another way, just for fun

Sub test()
Dim n As Long
On Error Resume Next
Do
n = n + 1
Err.Clear
Worksheets(n).Pictures("Auto").Delete
Loop Until Err.Number = 0 Or n >= Worksheets.Count
On error goto 0
End Sub

Regards,
Pete T