View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Patrick C. Simonds Patrick C. Simonds is offline
external usenet poster
 
Posts: 343
Default Remove an inserted picture

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



"Peter T" <peter_t@discussions wrote in message
...
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" wrote in message
...
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" <peter_t@discussions wrote in message
...
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


"Patrick C. Simonds" wrote in message
...
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\Ne w
Years Large.gif")
myPict.Top = .Top
myPict.Left = .Left
End With

Error:

End Sub