I found his macro in the archives and I use it to link pictures to a
cell, it works briliantly well, but it requires me to chance the source
cell manually, I would like it to work when the cell is changed by
formula. I believe this can be done by adding the "
worksheet_calculate" command, but have no idea how to do it, can anyone
help






Private Sub Worksheet_Change(ByVal Target As Range)


Dim rng As Range
Dim rngProducts As Range
Dim pic As Picture, shp As Shape
Dim szInvalids As String


On Error Resume Next
'Only insert the picture if it's in the area where they type the
Product Names
'Change "a1" to a range of cells where they'll be typing in Product
numbers
Set rngProducts = Intersect(Me.Range("a1"), Target)
On Error GoTo 0


If Not rngProducts Is Nothing Then 'They entered a product number
'Loop through each cell they entered in
' in case they copied several product numbers into several
cells
For Each rng In rngProducts
'Remove the exisitng picture (shape) from the cell to the
right
For Each shp In Me.Shapes
If shp.TopLeftCell.Address = rng.Offset(0, 1).Address _

Then shp.Delete
Next shp
'Insert the picture
On Error Resume Next
Set pic = ActiveSheet.Pictures.Insert("C:\Documents and
Settings\Ron\MyFiles\" _
& rng.Text & ".jpg")
On Error GoTo 0
If Not pic Is Nothing Then 'The picture exists
With pic
.Height = rng.Offset(0, 1).Height
.Width = rng.Offset(0, 1).Width
.Left = rng.Offset(0, 1).Left
.Top = rng.Offset(0, 1).Top
End With
Else 'Invalid entry, add it to the list of invalids
szInvalids = szInvalids & rng.Address & ": " & rng.Text
& vbLf
End If
Next rng


'Show them the invalid entries if there wer any
If Len(szInvalids) Then
szInvalids = "The following were either invalid product
entries or " & vbLf _
& "the product's image could not be found:" & vbLf & vbLf &
szInvalids
MsgBox szInvalids, vbExclamation
End If
End If
End Sub

If the only macros you have in your workbook are the ones that manipulate
picture displays, you might want to consider this non-vba approach. Users
won't be prompted to enable macros and it automatically reacts to the kind of
formula changes you described.

Assumption: Pictures are stored on Sheet2 to be dynamically shown on Sheet1.
Note: To add pictures to worksheets: <Insert<Picture from file

Select Sheet2
<Tools<Options<View tabUncheck Grid Lines
1)For each picture to be displayed:
Name the range of cells beneath the picture with a name beginning with "pic"
Example: <Insert<Name<Define Name: picEiffelTower

2)On Sheet1, build a data validation list in a cell and pick one of the items.

3)Create a dynamic range name that refers to that cell:
<Insert<Name<Define
Name: ShowMyPic
RefersTo: =INDIRECT("pic"&Sheet1!$A$1)

4)From the Control Toolbox, create an empty Picture control on Sheet1

5)With the picture selected, replace the formula bar contents with:
=ShowMyPic

The picture will be replaced by the picture referred to by the dropdown list.
Each time the value in that cell changes, the associated picture will appear
in the picture control and resize appropriately.

Is that something you can work with?

***********
Regards,
Ron

XL2002, WinXP-Pro


" wrote:

I found his macro in the archives and I use it to link pictures to a
cell, it works briliantly well, but it requires me to chance the source
cell manually, I would like it to work when the cell is changed by
formula. I believe this can be done by adding the "
worksheet_calculate" command, but have no idea how to do it, can anyone
help






Private Sub Worksheet_Change(ByVal Target As Range)


Dim rng As Range
Dim rngProducts As Range
Dim pic As Picture, shp As Shape
Dim szInvalids As String


On Error Resume Next
'Only insert the picture if it's in the area where they type the
Product Names
'Change "a1" to a range of cells where they'll be typing in Product
numbers
Set rngProducts = Intersect(Me.Range("a1"), Target)
On Error GoTo 0


If Not rngProducts Is Nothing Then 'They entered a product number
'Loop through each cell they entered in
' in case they copied several product numbers into several
cells
For Each rng In rngProducts
'Remove the exisitng picture (shape) from the cell to the
right
For Each shp In Me.Shapes
If shp.TopLeftCell.Address = rng.Offset(0, 1).Address _

Then shp.Delete
Next shp
'Insert the picture
On Error Resume Next
Set pic = ActiveSheet.Pictures.Insert("C:\Documents and
Settings\Ron\MyFiles\" _
& rng.Text & ".jpg")
On Error GoTo 0
If Not pic Is Nothing Then 'The picture exists
With pic
.Height = rng.Offset(0, 1).Height
.Width = rng.Offset(0, 1).Width
.Left = rng.Offset(0, 1).Left
.Top = rng.Offset(0, 1).Top
End With
Else 'Invalid entry, add it to the list of invalids
szInvalids = szInvalids & rng.Address & ": " & rng.Text
& vbLf
End If
Next rng


'Show them the invalid entries if there wer any
If Len(szInvalids) Then
szInvalids = "The following were either invalid product
entries or " & vbLf _
& "the product's image could not be found:" & vbLf & vbLf &
szInvalids
MsgBox szInvalids, vbExclamation
End If
End If
End Sub

Hi Ron

thanks for your reply

I have hundreds of picture in a directory, that is why the VBA aproach
is so atractive, is there no way to change the code to react to a
change if formulas?

Ron
This solution is so slick - just what I need for a project at work.
Many thanks!

Assumption: Pictures are stored on Sheet2 to be dynamically shown on Sheet1.
Note: To add pictures to worksheets: <Insert<Picture from file

Select Sheet2
<Tools<Options<View tabUncheck Grid Lines
1)For each picture to be displayed:
Name the range of cells beneath the picture with a name beginning with "pic"
Example: <Insert<Name<Define Name: picEiffelTower

2)On Sheet1, build a data validation list in a cell and pick one of the items.

3)Create a dynamic range name that refers to that cell:
<Insert<Name<Define
Name: ShowMyPic
RefersTo: =INDIRECT("pic"&Sheet1!$A$1)

4)From the Control Toolbox, create an empty Picture control on Sheet1

5)With the picture selected, replace the formula bar contents with:
=ShowMyPic

The picture will be replaced by the picture referred to by the dropdown list.
Each time the value in that cell changes, the associated picture will appear
in the picture control and resize appropriately.

Is that something you can work with?

***********
Regards,
Ron

XL2002, WinXP-Pro


" wrote:

I found his macro in the archives and I use it to link pictures to a
cell, it works briliantly well, but it requires me to chance the source
cell manually, I would like it to work when the cell is changed by
formula. I believe this can be done by adding the "
worksheet_calculate" command, but have no idea how to do it, can anyone
help






Private Sub Worksheet_Change(ByVal Target As Range)


Dim rng As Range
Dim rngProducts As Range
Dim pic As Picture, shp As Shape
Dim szInvalids As String


On Error Resume Next
'Only insert the picture if it's in the area where they type the
Product Names
'Change "a1" to a range of cells where they'll be typing in Product
numbers
Set rngProducts = Intersect(Me.Range("a1"), Target)
On Error GoTo 0


If Not rngProducts Is Nothing Then 'They entered a product number
'Loop through each cell they entered in
' in case they copied several product numbers into several
cells
For Each rng In rngProducts
'Remove the exisitng picture (shape) from the cell to the
right
For Each shp In Me.Shapes
If shp.TopLeftCell.Address = rng.Offset(0, 1).Address _

Then shp.Delete
Next shp
'Insert the picture
On Error Resume Next
Set pic = ActiveSheet.Pictures.Insert("C:\Documents and
Settings\Ron\MyFiles\" _
& rng.Text & ".jpg")
On Error GoTo 0
If Not pic Is Nothing Then 'The picture exists
With pic
.Height = rng.Offset(0, 1).Height
.Width = rng.Offset(0, 1).Width
.Left = rng.Offset(0, 1).Left
.Top = rng.Offset(0, 1).Top
End With
Else 'Invalid entry, add it to the list of invalids
szInvalids = szInvalids & rng.Address & ": " & rng.Text
& vbLf
End If
Next rng


'Show them the invalid entries if there wer any
If Len(szInvalids) Then
szInvalids = "The following were either invalid product
entries or " & vbLf _
& "the product's image could not be found:" & vbLf & vbLf &
szInvalids
MsgBox szInvalids, vbExclamation
End If
End If
End Sub