Sorry here it is again

[Richard1284]

Hi sorry but that last thread, here is my code I want to display a
different pic as each button s clicked however as I click the button I
also want to delete the old one. I am having problems with the latter.
I haave outlined where there is an error in my code, can you please
check it out and give me some ideas on what to do?
Much appreciated


Public myPic As Picture '
Public sPic As String
Sub InsertPic1()
'
' InsertPic1 Macro
' Macro recorded 23/05/2004 by Richard


sPic = Sheets("Main").Cells(100, 6).Value
------------------------------------------------------------
'error here on trying to detect if there is already a pic on sheet

If sPic <> "" Then
'I get the error here
Set myPic = ActiveSheet.Pictures(sPic)
myPic.Delete
End If
--------------------------------------------------------------

sPic = ("F:\Dss\ass\Arran1.jpg")
Sheets("Main").Select
Range("D16").Select
Set myPic = ActiveSheet.Pictures.Insert(sPic)

'storing pic ref here for delete
Sheets("Main").Cells(100, 6).Value = sPic

End Sub

 

[Tom Ogilvy]

Private Sub CommandButton1_Click
Dim sPic As String
Dim obj as Object

for each obj in Worksheets("Main").Pictures
if obj.topLeftCell.Address = "$D$16" then
obj.Delete
Exit for
end if
Next
sPic = ("F:\Dss\ass\Arran1.jpg")
Sheets("Main").Select
Range("D16").Select
ActiveSheet.Pictures.Insert sPic

End Sub

 

[Tom Ogilvy]

Here is a tested version. It is unclear if your button is on Main or
another sheet, but with this addition, it should work in either case.
Change the name of the picture to match yours. If you are using xl97 or
someone using xl97 will use you workbook, in the properties for the
commandbutton, change the takefocusonclick property to false.

Private Sub CommandButton1_Click()
Dim sPic As String
Dim obj As Object

For Each obj In Worksheets("Main").Pictures
If obj.TopLeftCell.Address = "$D$16" Then
obj.Delete
Exit For
End If
Next
sPic = ("C:\WINDOWS\Blue Rivets.bmp")
Sheets("Main").Select
Sheets("Main").Range("D16").Select
ActiveSheet.Pictures.Insert sPic

End Sub

 

[Bob Phillips]

Richard,

Just posted this to the other message

How about another approach?

What you could do is to load all of the pictures up front, and [park them
off-view. Each command button would move
back to the park, and then bring in the required one.

Dim sh As Shape

Fr Each sh In ActiveSheet.Shapes
'first make sure all parked
sh.Left = 5000
Next sh

With ActiveSheet.Shapes("picCB1")
.Left = 100
.Top = 100
End With

and similar code for each CB.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Tushar Mehta]

One way to implement persistence across VBA resetting global variables
is with your own names. Something like the code below, which names the
inserted object with a unique custom name. If you want to save the
information in a cell, save the object's name, not the name of the file
used to create the object.

Option Explicit
Sub addAPic(whatPic As String)
Dim x As Picture
On Error Resume Next
ActiveSheet.Shapes("_TMPic").Delete
On Error GoTo 0
Set x = ActiveSheet.Pictures.Insert(whatPic)
x.Name = "_TMPic"
End Sub
Sub Add1()
addAPic "C:\pic1.jpg"
End Sub
Sub Add2()
addAPic "C:\pic2.jpg"
End Sub


--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions