Macro to input picture

[jmsimps1]

I'm trying to write a macro that will read a number in a cell and go into a file and retrieve the picture that correlates to that number.

As an example if I put 0600 in A1 i want the macro to go into a file and pick out the the 0600.jpg.

 

[Domenic]

I'm not sure that this is exactly what you're looking for, but maybe something like this...

1) Right-click the sheet tab for the sheet of interest.

2) Copy the following code in the code module for the sheet:

[font=Courier New][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_Change([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range)
    [color=darkblue]If[/color] Target.Address <> "$A$1" [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]Call[/color] DeletePic
    [color=darkblue]If[/color] Target.Value <> "" [color=darkblue]Then[/color]
        [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]
        [color=darkblue]Dim[/color] strFile [color=darkblue]As[/color] [color=darkblue]String[/color]
        [color=darkblue]Dim[/color] objPic [color=darkblue]As[/color] Picture
        [color=darkblue]Dim[/color] Pic [color=darkblue]As[/color] Picture
        strPath = "C:\Users\Domenic\Documents\Pictures\" [color=green]'change the path accordingly[/color]
        strFile = Target.Value & ".jpg"
        [color=darkblue]If[/color] Dir(strPath & strFile) <> "" [color=darkblue]Then[/color]
            [color=darkblue]Set[/color] objPic = Me.Pictures.Insert(strPath & strFile)
            objPic.Top = Target.Offset(, 1).Top
            objPic.Left = Target.Offset(, 1).Left
        [color=darkblue]Else[/color]
            MsgBox "Picture """ & Target.Value & ".jpg"" cannot be found!", vbExclamation
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] DeletePic()
    [color=darkblue]Dim[/color] oPic [color=darkblue]As[/color] Picture
    [color=darkblue]For[/color] [color=darkblue]Each[/color] oPic [color=darkblue]In[/color] Me.Pictures
        [color=darkblue]If[/color] oPic.TopLeftCell.Address = "$B$1" [color=darkblue]Then[/color]
            oPic.Delete
            [color=darkblue]Exit[/color] [color=darkblue]For[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] oPic
End [color=darkblue]Sub[/color]
[/font]

So, basically, when a value is entered in A1, the corresponding picture will be inserted at B2. If a new value is entered in A1, the old picture is deleted and the new one again is inserted at B2. If the content of A1 is deleted, the picture is also deleted.

 

[jmsimps1]

This is perfect thank you!!! One other question is there a way I can the macro automatically search in the folder that the excel spreadsheet is located to find the picture?

Example the spreadsheet is saved in C:\Users\Excel\Downloads and I also have the pictures located there that same folder, is there a way that I don't have to put in the folder structure into the macro?

 

[Domenic]

Try replacing...

strPath = "C:\Users\Domenic\Documents\Pictures\"

with

strPath = ThisWorkbook.Path & "\"

 

[jmsimps1]

Domenic, you are amazing my friend.

 

[rockyw]

Domenic Will this macro insert multiple pics? I have been asking for a macro for this but I have gotten no replys. I would also like to put the images in rows, 3 or 4 wide and then down as far as needed. Hope you can help. Thanks