Displaying Images from Folder on Network in Excel Based on Cell Value

[Panda]

Hi All,

Me again...basically at work I have a spreadsheet that contains a drop down menu containing all the parts that we ship. What I am trying to do is get exel to display an image of the part that has been chosen from the drop down menu. For example is 'M5 Screw' is selected from the list then in a cell an image of said screw will appear.

In order to keep the size of the spreadsheet down I have stored all the images (jpgs) in a folder on the network with each image saved as the same name it is refered to in the drop down menu. Is it possible to get the image to display from this network path depending on the value that is selected from the drop down menu?

Thanks

Phil

[mdmackillop]

Can you post a small sample showing your dropdown arrangement.

[Panda]

Sorry for the late reply, yeah attached is an example of the sheet. Basically when the user selects a part type from the drop down menu, I would like to display an image of the chosen part. However rather then storing all of the images in the workbook, I would like to store them within a folder on the network drive so that the file size of the spreadsheet remains small.

Is this possible?

[GTO]

Hi Panda,

I'm not sure if I'm picking exactly the correct constants, but this seems to work. The first one uses shapes and links the pic. Just as I was playing around a bit, the second way uses an image control, but the pic ends up saving (I'm presuming based on filesize) as the control is on the sheet. (different from on a userform I believe)

In the Worksheet's Module:

Option Explicit
    
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngPicNames As Range
    
Const Path As String = "G:\2011\2011-01-24\"
    
    If Not Application.Intersect(Target, Range("C2")) Is Nothing _
    And Target.Count = 1 Then
        '--- shapes / linked ---
        Set rngPicNames = Sheet2.Range(Mid(Range("C2").Validation.Formula1, 2))
        
        If Not IsError(Application.Match(Range("C2"), rngPicNames, 0)) Then
            If Not ChangePic(Path & rngPicNames.Offset(, 1).Cells( _
                                Application.Match(Range("C2"), rngPicNames, 0)).Value, "MyPic") Then
                
                MsgBox "Unable to locate pic"
            End If
        End If
        
        '--- image control ---
        If Not IsError(Application.Match(Range("C2"), rngPicNames, 0)) Then
            With Me.imgPart
                .Picture = LoadPicture(Path & _
                                      rngPicNames.Offset(, 1).Cells( _
                                        Application.Match(Range("C2"), rngPicNames, 0)).Value)
            End With
        End If
        
    End If
End Sub

In a Standard Module:

Option Explicit
    
Function ChangePic(Path As String, shpName As String) As Boolean
Dim _
shpPic      As Object, _
dblPicHgt   As Double, _
dblPicLeft  As Double, _
dblPicTop   As Double, _
dblPicWid   As Double
    
    On Error GoTo errPrint
    
    Set shpPic = Sheet1.Shapes(shpName)
        
    With shpPic
        dblPicHgt = .Height
        dblPicLeft = .Left
        dblPicTop = .Top
        dblPicWid = .Width
        .Delete
    End With
    
    Set shpPic = Sheet1.Shapes.AddPicture(Path, msoTrue, msoFalse, dblPicLeft, _
                                          dblPicTop, dblPicWid, dblPicHgt)
    shpPic.Name = "MyPic"
    ChangePic = True
Exit Function
errPrint:
    Select Case Err.Number
    Case -2147024809
        MsgBox "The picture/shape with the specified name of ""MyPic"" wasn't found.", _
                vbCritical, vbNullString
    Case 1004
        MsgBox "Missing picture file or bad path", vbCritical, vbNullString
    End Select
End Function

Hope that helps a little at least,

Mark

[GTO]

Oops...

PS - PLease note that I used the sheets' default codenames. Also - I failed to explain that I am assuming the .jpg's are in one folder. In the above, the image filenames would be in the cells adjacent to your DV's list in Col A on sheet2.

Mark

[Panda]

Hi GTO

Thanks for your reply, but I cant seem to get the code to work. I have changed file path to where the images are stored on the Network and when I try to select a part from the drop down menu I get a 'Compile Error, Method or Data Member not Found'

Am I doing something wrong? I have attached the spereadsheet with the code put in.

Thanks again for your help =

[Kenneth Hobs]

For one thing, your constant that defines the path does not end in a trailing backslash.

Using what GTO did with a few tweaks, you can do it like this. But first, do this.
1. Insert a Picture object.
2. Name the object, MyPic.
a. To do this, click the object and in the Name box, overwrite the "Picture 1" with "MyPic" and press enter key.

I assumed that the description picked was the base part of the filename. If that is not the case, you will need to add an offset column with the filename next to your PART_DESCRIP range as GTO assumed, I think. My sheet code would then need a slight tweak.

e.g.
If the sPath is say "x:\pics\" and the part picked is PCB1 then the assumed filename would be "x:\pics\PCB1.jpg".

Right click the Sheet1 tab, View Code, and paste:
[vba]Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, fn As String, tf As Boolean
Const sPath As String = "C:\Documents and Settings\phi107\Desktop\Test Images\"
'Const sPath As String = "x:\pics\"

'Exit if the target changed was not the part description cell.
Set r = Range("C2")
If Target <> r Then Exit Sub

'Create the filename to add as a link to the MyPic named Picture object.
fn = sPath & r.Value & ".jpg"

'Exit if the filename does not exist.
If Dir(fn) = Empty Then Exit Sub

'An existing picture with the Name of MyPic should exist before this.
tf = ChangePic(fn, ActiveSheet.Shapes("MyPic"))
End Sub[/vba]
In a Module, paste:
[vba]Option Explicit

Function ChangePic(Path As String, shpPic As Shape) As Boolean
Dim x As Single
Dim _
dblPicHgt As Single, _
dblPicLeft As Single, _
dblPicTop As Single, _
dblPicWid As Single

On Error GoTo errPrint

With shpPic
dblPicHgt = .Height
dblPicLeft = .Left
dblPicTop = .Top
dblPicWid = .Width
.Delete
End With

Set shpPic = Sheet1.Shapes.AddPicture(Path, msoTrue, msoFalse, dblPicLeft, _
dblPicTop, dblPicWid, dblPicHgt)
shpPic.Name = "MyPic"
ChangePic = True
Exit Function
errPrint:
Select Case Err.Number
Case -2147024809
MsgBox "The picture/shape with the specified name of ""MyPic"" wasn't found.", _
vbCritical, vbNullString
Case 1004
MsgBox "Missing picture file or bad path", vbCritical, vbNullString
End Select
End Function
[/vba]

[mdmackillop]

You could also use something like this in the Sheet2 module to allow you to scroll down column 1 to view the images

[VBA]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pth As
String, shpPic As Shape
pth = "C:\AAA\"


If Target.Column = 1 Then
On Error Resume
Next
ActiveSheet.Shapes(1).Delete
Set shpPic =
ActiveSheet.Shapes.AddPicture(pth & Target & ".jpg", msoTrue, msoFalse,
Target.Offset(, 1).Left, Target.Top, 100, 100)
End If
End Sub

[/VBA]

[Panda]

Thanks for your help guys, but at the risk of sounding VERY stupid, how do you insert a picture object. When I go into 'Insert' > 'Object' I cant seem to find anything in the 'Create New' tab other then 'Bitmap Image' which I cant seem to rename as 'Mypic' as mdmackillop suggests.

Sorry if this is something that is really really simple

Thanks again

Panda

[mdmackillop]

In 2003
Insert/Picture/From file
Records as
[VBA]
ActiveSheet.Pictures.Insert ("Z:\My Pictures\Ticks.JPG")
[/VBA]

Which version of Excel are you using?

[GTO]

...how do you insert a picture object. When I go into 'Insert' > 'Object' ...rename as 'MyPic' as mdmackillop suggests...

Hi Panda,

I do not wish to confuse matters, and maybe I should have only shown the one method; particularly as you want to link to the pic. That said, I think the attached is what I had yesterday, and it was working (both methods). It definitely needs further coding, as it doesn't check for the image files' existance and maybe other things I missed.

When creating the initial picture, or that is, the Shape, in 2000/2003, go to Insert|Picture|From File...

After inserting a shape manually, you can rename it in the name box left of teh formula bar (leastwise prior to 2007?)

I hope this helps,

Mark

Hi Malcom, Hi Ken long time since I've been able to say Howdy!

[Panda]

Thanks all, for your help we finally got it working =

Thanks again for your time, you have just made inspection of PCBs fool proof lol

Panda