How to add a picture to another sheet based on the sheet value on another sheet?

Question

Recently, I adapted this code, and it works well because it selects the picture and place it in the selected cell, but how to do it automatically without select and place , based on cell value.

I want to add a picture to sheet2 based on the cell value on sheet1. Let's say I have a picture of an animal in a folder "D:\OneDrive\Desktop\TES2" and I must save the animal's image on sheet2 based on its name on sheet1.

PS: I need to store 1 or 2 pictures in sheet2 in one cell with the same name as in sheet1 but with different extensions (jpg & jfif).

this is sheet1 (name of the animal).

this is sheet2 (cell to store the animal picture)

This code is as follows: select image and place it in the selected cell and save it within the workbook.

I use this code because there are only a few pictures, maybe around 200, but over time there will be more and more.

Private Sub btn_pilihgambar_Click()
    Sheet3.Activate
    Dim uk_gbr As Range
    Dim gbr As Object
    Dim tp_gbr As String
    
    tp_gbr = Application.GetOpenFilename("Pilih Gambar (*.jfif; *.jpg; *.png)," & _
    "*.jfif; *.jpg; *.png")
    
    If tp_gbr <> CStr(False) Then
    On Error Resume Next
        Set uk_gbr = Application.InputBox("Pilih Cell:", "Masukkan Gambar", ActiveCell.Address, Type:=8)
    On Error GoTo 0
        uk_gbr.Activate
               
        Set gbr = ActiveSheet.Shapes.AddPicture(Filename:=tp_gbr, _
            linktofile:=msoFalse, _
            savewithDocument:=msoTrue, _
            Left:=uk_gbr.Left, _
            Top:=uk_gbr.Top, _
            Width:=-1, _
            Height:=-1)
            gbr.Height = 249.84
            gbr.LockAspectRatio = msoCTrue
    End If

    Set uk_gbr = Nothing
    Set gbr = Nothing
End Sub

Answer 1

The code below shows how to copy/paste a picture from one worksheet to another or how to insert a picture based on a file path and file name displayed in a cell

The code goes into the ThisWorkbook code module and will activate every time a cell value is changed. You will need to modify it to make it work for your needs but it should get you most of the way there. I've got comments in the code to explain what different sections of it do and you can uncomment/comment sections out to use what you want.

Option Explicit


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim tShp As Shape
        If Sh.Name = "Sheet2" Then ' check to make sure this is the sheet that you want to monitor for changes
            If Target.Address = "$A$2" Then ' this checks to see if it is a specific cell you want to monitor for changes
                Application.ScreenUpdating = False
                
    '==========================================
    'this section deletes all existing pictures on the page before pasting or inserting a new one.
                'For Each tShp In Sh.Shapes
                '    tShp.Delete
                'Next tShp
    '==========================================
    
    '==========================================
    'this section delets pictures which intersect a given cell range
                For Each tShp In Sh.Shapes
                    If Not Application.Intersect(tShp.TopLeftCell, Sh.Range("E2")) Is Nothing Then
                        tShp.Delete
                    End If
                Next tShp
                
    '===========================================
    'use this to copy the picture from the "Pictures" sheet
                'Sheets("Pictures").Shapes(Sh.Range("A2").Value).Copy
                'Sh.Paste
    '===========================================
    
    '===========================================
    'use this to insert from a file and give the picture in excel the same name as the file name
                Sh.Pictures.Insert("{Some_File_Path_here}" & "\" & Sh.Range("A2").Value).Name = Sh.Range("A2").Value
    '===========================================
    
                With Sh.Shapes(Sh.Range("A2").Value)
                    .Top = Sh.Range("E2").Top
                    .Left = Sh.Range("E2").Left
                End With
                Application.ScreenUpdating = True
            End If
        End If
End Sub