PDA

View Full Version : Displaying Images from Folder on Network in Excel Based on Cell Value



Panda
01-22-2011, 10:14 AM
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
01-22-2011, 01:23 PM
Can you post a small sample showing your dropdown arrangement.

Panda
01-24-2011, 02:19 AM
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
01-24-2011, 08:53 AM
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
01-24-2011, 08:56 AM
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
01-24-2011, 09:41 AM
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
01-24-2011, 11:44 AM
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:
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
In a Module, paste:
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

mdmackillop
01-24-2011, 12:56 PM
You could also use something like this in the Sheet2 module to allow you to scroll down column 1 to view the images



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

Panda
01-25-2011, 02:12 AM
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
01-25-2011, 03:19 AM
In 2003
Insert/Picture/From file
Records as

ActiveSheet.Pictures.Insert ("Z:\My Pictures\Ticks.JPG")


Which version of Excel are you using?

GTO
01-25-2011, 04:41 AM
...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 :hi: long time since I've been able to say Howdy!

Panda
01-25-2011, 04:55 AM
Thanks all, for your help we finally got it working =:D

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

Panda