please help! Linking a picture to a cell and recalculating automatically

D

danetrak

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
 
R

Ron Coderre

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 tab>Uncheck 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
 
D

danetrak

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?
 
H

Holly R

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top