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