Consulting

Results 1 to 1 of 1

Thread: show and hide photos with formula

  1. #1

    show and hide photos with formula

    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.

    Screen Shot 2021-06-09 at 10.26.01 AM.jpg

    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.
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •