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 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
>
>
> "danetrak_at_gmail.com" 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
> >
> >
Received on Sat Jul 01 2006 - 07:18:02 PDT