Excel Display Image Based On Cell Value

Display Image Dynamically Based On Cell Contents  

       In some cases, we may need to see the picture of the value in the cell. This image can be large, and when inserted in a cell on the sheet, it creates a large size workbook. This is an undesirable situation, transactions on the worksheet are performed more slowly.

As a solution, we can display image based on a cell value from directory by VBA. For this purpose; we have added the pictures to a folder , the picture with the same name as value of the selected cell is called up from folder and displayed to the user in its original size.

By adding simple codes that allow us to show images based on cell content to the Worksheet_SelectionChange procedure, we have obtained a useful template. ↓

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim fso As Object

If Target.Address = "$A$1" Then
Image1_Click
Exit Sub
ElseIf Target.Address = "$A$" & ActiveCell.Row Then
Image1.Visible = True
Image1.Top = ActiveCell.Top
Image1.Left = ActiveCell.Offset(0, 5).Left

For Each shp1 In ActiveSheet.Shapes
    If shp1.Name = "Sekil" Then
Shapes("Sekil").Visible = msoTrue
Shapes("Sekil").Top = ActiveCell.Top + 5
End If
Next
End If

On Local Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(ThisWorkbook.Path & "\Images\" & Trim(ActiveCell.Value) & ".jpg") = True Then
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Images\" & Trim(ActiveCell.Value) & ".jpg")

ElseIf fso.FileExists(ThisWorkbook.Path & "\Images\" & Replace(ActiveCell.Value, " ", "") & ".jpg") -

     = True Then
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Images\" & Replace(ActiveCell.Value, " ", "") & ".jpg")
Else
Image1.Visible = False
End If
End Sub 

► Firstly, we added the Images folder in the same place as the workbook and placed the images in this folder. We have added an Image control to the worksheet and hidden it.

In our template, we sorted the products in column A and when any cell in column A is selected, if there is an image of the product in Images folder, Image control (Image1) is made visible and the image is shown on Image control . The location of Image1 is dynamically adjusted relative to the selected cell in column A . This position corresponds to column F. ↓

Image1.Visible = True
Image1.Top = ActiveCell.Top
Image1.Left = ActiveCell.Offset(0, 5).Left 

The image (with .jpg extension) with the same name as the value (product name) in the active cell is found in Images folder and displayed on Image1. Sometimes there may be unnecessary spaces in value of the cell, and the result is that the image cannot be displayed because it does not match the image name. Or there may be no spaces in the image name, there may be spaces between the words in the cell value, as a result, the picture cannot be displayed.
       For example ; Value of A6 cell : Coil 8mm    →   Name of image : Coil8mm.jpg

We added Trim and Replace functions to VBA codes to prevent such situations and remove spaces. ↓

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim fso As Object
...
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(ThisWorkbook.Path & "\Images\" & Trim(ActiveCell.Value) & ".jpg") = True Then
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Images\" & Trim(ActiveCell.Value) & ".jpg")

ElseIf fso.FileExists(ThisWorkbook.Path & "\Images\" & Replace(ActiveCell.Value, " ", "") -
    & ".jpg") = True Then
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Images\" & Replace(ActiveCell.Value, " ", "") -
    & ".jpg")
Else
Image1.Visible = False
End If
...  

When it is clicked on the image or clicked a cell other than column A, image is hide.

► We added an arrow shape to the template to highlight the selected cell. This arrow moves dynamically according to the selected cell.

When the worksheet is active, it is checked, if there is no figure, it is created with VBA codes and a name(Sekil) is given. ↓

Private Sub Worksheet_Activate()
Dim shp As Object, shp1 As Shape
For Each shp1 In ActiveSheet.Shapes
    If shp1.Name = "Sekil" Then
     Exit Sub
    End If
Next shp1
Set shp = ActiveSheet.Shapes.AddShape(msoShapeRightArrow, Range("A1").Width - 15, 10, 8, 6)
shp.Name = "Sekil"
shp.Visible = False
End Sub