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]

Put the following code in the events of your sheet.
Change ".jpg" by the extension of your files.
Change "A2" to the cell where you have your drop down box

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Target.Address(0, 0) = "[COLOR=#ff0000]A2[/COLOR]" Then
        Dim wdesk As String, wfile As String
        wdesk = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
        wfile = Target.Value & ".[COLOR=#ff0000]jpg[/COLOR]"
        On Error Resume Next
        ActiveSheet.DrawingObjects("img_tmp").Delete
        On Error GoTo 0
        If Dir(wdesk & wfile) <> "" Then
            With ActiveSheet.Pictures.Insert(wdesk & wfile)
                .Name = "img_tmp"
                .ShapeRange.LockAspectRatio = msoFalse
                .Top = Target.Offset(, 1).Top
                .Left = Target.Offset(, 1).Left
                .Width = Target.Offset(, 1).Width
                .Height = Target.Offset(, 1).Height
            End With
        End If
    End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.

 

[Malcolm torishi]

Hi
I now have an IF formula rather than a drop down box that inserts the name Tom or Jack into the cell. But for some reason it doesn’t want to insert the photo. Can anyone tell me please if this code can be changed to it will work with the IF formula
thank you

 

[DanteAmor]

put the formula here to review it

 

[Malcolm torishi]

Hi Dante
my if formula is
=IF(A2=“Tom”,1,””)
so each time the name Tom appears in cell A2 say, Tom,s photo will insert from the file on my desktop onto the spreadsheet
hope this helps you.
Thank you

 

[DanteAmor]

Hi Dante
my if formula is
=IF(A2=“Tom”,1,””)
so each time the name Tom appears in cell A2 say, Tom,s photo will insert from the file on my desktop onto the spreadsheet
hope this helps you.
Thank you

I'm confused
You can explain again.
In which cell you have the formula.
In which cell are you going to capture something?

Before changing the dropdown list to formula. You tried the macro

 

[Malcolm torishi]

I'm confused
You can explain again.
In which cell you have the formula.
In which cell are you going to capture something?

Before changing the dropdown list to formula. You tried the macro

Hello Dante
Sorry for the confusion but let me try andexplain.

I have the following VBA Code in myworksheet sheet with the sheet/tab known as “Photo ID 1”

Private Sub Worksheet_Change(ByVal TargetAs Range)

DimmyPict As Picture
DimPictureLoc As String

IfTarget.Address = Range("B6").Address Then

ActiveSheet.Pictures.Delete

PictureLoc ="C:\Users\proctm\Desktop\image" & Range("B6").Value& ".jpeg"

WithRange("C4")
SetmyPict = ActiveSheet.Pictures.Insert(PictureLoc)
.RowHeight = 19.5
myPict.Top = .Top
myPict.Height = 375
myPict.Width = 375
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
EndWith

EndIf
EndSub

I also have an IF Formula on that same worksheet,“Photo ID 1”, in cellB6
=IF(OUT!AJ7="","Blank",OUT!AJ7)

I have another worksheet call “OUT” and in cellAJ7 the name “Tom” can appear depending on the criteria. Thus putting “Tom into cell B6 on my “PhotoID 1 “ worksheet. If “Tom” does not appearthen the cell is left blank and the word “Blank” will appear in cell B6 on my “Photo ID 1 “

Basically Photo ID 1 cell C6 should switch from “Tom” to “Blank” andshould change the photo accordingly, but it’s not changing.


On my desktop I have a folder with photosof Tom.jpeg and Blank.jpeg

What’s not happening is each time the cellchanges on sheet Photo ID 1 cell B6 from Tom to Blank the photo does not change,
thank you op I have explained

 

[DanteAmor]

Remove the Change event and put this in its place:

Private Sub Worksheet_Calculate()
  Dim myPict As Picture, PictureLoc As String
  On Error Resume Next
  ActiveSheet.DrawingObjects("img_tmp").Delete
  On Error GoTo 0
  
  PictureLoc = "C:\Users\proctm\Desktop\image[B][COLOR=#ff0000]\[/COLOR][/B]" & Range("B6").Value & ".[B][COLOR=#ff0000]jpeg[/COLOR][/B]"
  With Range("C4")
    Set myPict = ActiveSheet.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

Check the name of your folder, check if it should end in \
Also check the extension.

 

[Malcolm torishi]

Remove the Change event and put this in its place:

Private Sub Worksheet_Calculate()
  Dim myPict As Picture, PictureLoc As String
  On Error Resume Next
  ActiveSheet.DrawingObjects("img_tmp").Delete
  On Error GoTo 0
  
  PictureLoc = "C:\Users\proctm\Desktop\image[B][COLOR=#ff0000]\[/COLOR][/B]" & Range("B6").Value & ".[B][COLOR=#ff0000]jpeg[/COLOR][/B]"
  With Range("C4")
    Set myPict = ActiveSheet.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

Check the name of your folder, check if it should end in \
Also check the extension.

Thank you Dante I will look tomorrow

 

[Malcolm torishi]

Thank you Dante I will look tomorrow

Hello Dante
i checked the code and made sure I have the \ and jpeg correct. But unfortunately it still didn’t want to work using the IF formula I mentioned above. It did however change the photos if I manually typed in a photo file name into cell B6.
Do you have any other ideas I could try . Thank you if you can help .