VBA Code to insert a picture into a cell

[Malcolm torishi]

Hi does any one know if you can insert a picture, file name say Tom, into a cell. So if I have the word Tom in a drop down box in cell A1. I would like the picture of Tom to appear in cell B1 and sized to fit in a cell say 100x 100. And if I change the name to say to Jack then Jacks photo will appear in cell B1. The photos are saved on my desktop. If anyone can help I would appreciate it
thank you

 

[DanteAmor]

It means that you are going to make changes to the sheet "OUT" and the sheet "PhotoID 1" in the cell "B6" a new data will be reflected.
Then try the following:

Private Sub Worksheet_Calculate()
  Dim myPict As Picture, PictureLoc As String, sh As Worksheet
  Set sh = Sheets("[B][COLOR=#ff0000]PhotoID 1[/COLOR][/B]")
  On Error Resume Next
  [COLOR=#0000ff]sh.[/COLOR]DrawingObjects("img_tmp").Delete
  On Error GoTo 0
  
  PictureLoc = "C:\Users\proctm\Desktop\image\" & [COLOR=#0000ff]sh.[/COLOR]Range("B6").Value & ".jpeg"
  With [COLOR=#0000ff]sh.[/COLOR]Range("C4")
    Set myPict = sh.Pictures.Insert(PictureLoc)
    .RowHeight = 19.5
    myPict.Name = "img_tmp"
    myPict.Top = .Top
    myPict.Height = 375
    myPict.Width = 375
    myPict.Left = .Left
    myPict.Placement = xlMoveAndSize
  End With
End Sub

 

[Malcolm torishi]

Dante
what can I say but Thank You ,it works brilliant. The photos insert into the correct place and change using the formula.
There is one other thing that’s cropped up from this thou, because I have the following Module that inserts a ticking clock on to a worksheet. The whole work book command buttons and the photos you helped me get to insert on a worksheet keeps flickering. The code for the clock is as below. Would you know how to stop this flickering please. Thank you if you can help. Have I tried to insert
Application.ScreenUpdating = False
Application.ScreenUpdating = True
at the beginning and end of your VBA Code to insert the photos. But it’s not helped

Dim SchedRecalc As Date
Sub Recalc()
With Sheet1.Range("Z4")
.Value = Format(Time, "hh:mm:ss AM/PM")
End With
Call Settime
End Sub


Sub Settime()
SchedRecalc = Now + TimeValue("00:00:01")
Application.OnTime SchedRecalc, "Recalc"
End Sub


Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc", Schedule:=False
End Sub

 

[DanteAmor]

Dante
what can I say but Thank You ,it works brilliant.

I'm glad to help you. Thanks for the feedback.

For the next topic, the right thing is to open a new thread