Insert picture with macro
 

I have red the reference articles and questions on displaying a picture when
changing a reference in a cell. I do not want to save the picture in the
worksheet but rather save the path in a cell to be a lookup. Is this
possible? I am designing a orderform.
Thank you

Esrei

Insert picture with macro
 

hi,

that's all possible, you can use:
Assume that range("A1") text is correct filename like "C:\picture.bmp"
sub insertpic()
sheets(1).pictures.insert range("A1")
end sub

--
Regards,

Halim



"Esrei" wrote:

I have red the reference articles and questions on displaying a picture when
changing a reference in a cell. I do not want to save the picture in the
worksheet but rather save the path in a cell to be a lookup. Is this
possible? I am designing a orderform.
Thank you

Esrei

Insert picture with macro
 

Hi Esrei

I wrote the code below a while ago and I think it may be of some use
to you. List your picture names in the worksheet (i.e. my
picture.jpg) then when you click on this cell a rectangle with the
picture will show beside that cell.

In the module for the worksheet with your picture names paste the
following code.

Option Explicit

Dim H, V As Integer
Dim I As Integer
Dim MyDoc As Worksheet

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set MyDoc = ActiveSheet 'Set your worksheet

H = Target.Offset(0, 1).Left 'Get the values for placement
V = Target.Offset(0, 1).Top 'of the picture

I = MyDoc.Shapes.Count 'Count shapes in MyDoc

If I 0 Then 'If any shape exist delete all shapes
MyDoc.Shapes("Comment").Select
Selection.Delete
End If

If Target.Count 1 Then 'Check than only one cell is selected
Exit Sub
End If

If Target.Value = "" Then 'Check cell has a value
Exit Sub
End If

'Load the picture to the shape, 200 = shape width, 100 = shape height
'the file location should be changed to show your picture directory.

MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 200, 100).Select
Selection.Name = "Comment"
Selection.ShapeRange.Fill.UserPicture "C:\Pics\" & Target.Value

End Sub

Hope it helps you

S