Excel Insert Picture Dynamically In Cell Based On Cell Value & Delete Picture

Excel VBA Insert Picture To Cell And Delete Picture In Cell


How To Insert Image Or Picture Dynamically In Cell Based On Cell Value In Excel?

           In the template that we created earlier, only we added images from the folder according to the cell value .
We were entering a value in column A, and if there were any pictures that match that value, that picture was adding to column E (For example ; value:A01 ,the added image to Column E :A01.jpg).
When the value in column A was deleted or changed, the image in column E was staying fixed in his cell.
           For efficient use of the template, when the value in column A is deleted or changed, the image associated with this value must be deleted.
To this end, we have made the changes in Vba codes to delete picture from cell .

Our codes:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim pic As Picture
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub

On Error GoTo son
For Each pic In ActiveSheet.Pictures
    If Not
Application.Intersect(pic.TopLeftCell, Range(Target.Offset(0, 4).Address)) Is
Nothing Then
        pic.Delete
    End If
Next pic
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(0, 2).Top
Selection.Left = Target.Offset(0, 4).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = Target.Offset(0, 2).Height
Selection.ShapeRange.Width = Target.Offset(0, 4).Width
Target.Offset(1, 0).Select
son:
 End Sub

The loop that we created to delete picture in cell:
For Each pic In ActiveSheet.Pictures
    If Not Application.Intersect(pic.TopLeftCell, Range(Target.Offset(0, 4).Address)) Is Nothing Then
        pic.Delete
    End If
Next pic

The user may want to add the picture of the value in column A to column C, not to column E. In this case it is necessary to make changes to the codes:
For Each pic In ActiveSheet.Pictures
    If Not Application.Intersect(pic.TopLeftCell, Range(Target.Offset(0, 2).Address)) Is Nothing Then
        pic.Delete
    End If
Next pic
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(0, 2).Top
Selection.Left = Target.Offset(0, 2).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = Target.Offset(0, 2).Height
Selection.ShapeRange.Width = Target.Offset(0, 2).Width
Target.Offset(1, 0).Select
son: 

2 comments:

  1. Hi.
    If you send excel file to someone without images in directory, they will not see images in that excel file.
    Is it possible to add all images first to other sheet and then pick then from there? This could be usefule when creating example catalogs, where images are there only show more information

    ReplyDelete
  2. Hi,
    It may be possible. However, the size of the excel file increases a lot.

    ReplyDelete