show and hide photos with formula

[forerver]

Hi,

Good day. I need your help to fix this code. The code is work. But the issue only when i add the formula in column (fruit name) the picture not display. Please can you help this the small issue. Because i need to add formula in fruit based on the SN. The main value is C2 because that the name of photos.


Because some supplier send only the SN without the name of fruit. Then some supplier send item with barcode then I scanned the SN barcode from items. Then im using the vlookup from my database to find the name of fruit based on the SN.

28584

here the code.



Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape
Dim rng As Range, c As Range
Dim img As String, imgName As String
Const filepath As String = "D:\fruits\"

Application.ScreenUpdating = False
Set rng = Intersect(Target, Range("C2:C" & Rows.Count))
If Not rng Is Nothing Then
For Each c In rng
With c.Offset(0, -1)
imgName = "PictureAt" & .Address
On Error Resume Next
Me.Shapes(imgName).Delete
On Error GoTo 0

If Dir(filepath & "NOPHOTO.jpg") <> "" Then img = filepath & "NOPHOTO.jpg"
If Dir(filepath & c.Value & ".jpg") <> "" Then img = filepath & c.Value & ".jpg"
If img <> "" Then
Set shp = Me.Shapes.AddPicture(img, msoFalse, msoTrue, .Left, .Top, 200, 200)
shp.Name = imgName
shp.ScaleHeight 1, msoTrue
shp.ScaleWidth 1, msoTrue
shp.LockAspectRatio = msoTrue
shp.Height = c.Cells(1).Height - 4
shp.Left = .Left + ((.Width - shp.Width) / 2)
shp.Top = .Top + ((.Height - shp.Height) / 2)
End If
End With
Next
End If
Application.ScreenUpdating = True
End Sub

here the excel sample


Please i need you help to fix this. thanks advance.