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
|