Repeat image for lines below - MACRO

Question

The VBA formula to insert pictures in the spreadsheet works, however I need to repeat the same code for lines below, however the image is deleted from the previous line, appearing only in the line where I just entered the code.

For example: If I put the dog code on lines 1 and 2, it erases the dog’s photo from one of the lines and the photo appears in a single line. I need the photo to appear on every line that has the dog code.

I don’t know if it’s clear.

Follows code:

Public Function getImage(ByVal sCode As String) As String

    Dim sFile As String
    Dim oSheet As Worksheet
    Dim oCell As Range
    Dim oImage As Shape

    Set oCell = Application.Caller ' Célula onde a função foi chamada
    Set oSheet = oCell.Parent      ' Planilha que chamou a função

    ' Procura por uma imagem existente identificada pelo código (que precisa ser único!)
    Set oImage = Nothing
    For i = 1 To oSheet.Shapes.Count
        If oSheet.Shapes(i).Name = sCode Then
            Set oImage = oSheet.Shapes(i)
            Exit For
        End If
    Next i


    ' Se ainda não existir uma imagem com o código, carrega do arquivo e cria-a.
    ' A imagem já é posicionada na exata posição da célula onde a função foi chamada.
    If oImage Is Nothing Then
        sFile = "c:\temp\sopt\" & sCode & ".jpg"
        Set oImage = oSheet.Shapes.AddPicture(sFile, msoCTrue, msoCTrue, oCell.Left, oCell.Top, oCell.Width, oCell.Height)
        oImage.Name = sCode

    ' Caso contrário, se a imagem já existir, garante que ela se posiciona e cabe exatamente dentro da célula
    ' (apenas para o caso do usuário ter movido ou redimensionado manualmente a imagem sem querer)
    Else
        With oImage
            .Left = oCell.Left
            .Top = oCell.Top
            .Width = oCell.Width
            .Height = oCell.Height
        End With
    End If

    ' Retorna nada para a célula (afinal, esta é somente uma função de auxílio)
    getImage = ""

End Function

Answer 1

First, thank you for returning my comment by posting your code!

Basically, what I did was change the variable to capture the image from "Shape" to "Picture" and thus use the Insert method, which does not cause the "disappearance" of the image that was causing you problems.

Just watch to change, in the code below, the name of the worksheet tab where the images will be inserted and the folder path where the images are:

Public Function InserirImagem(ByVal Nome As String) As String

Dim W       As Worksheet
Dim objPic  As Picture
Dim rngCell As Range
Dim strFolder   As String
Dim strFileName As String

'Seleciona a aba e a célula ativa
Set W = Sheets("Base")
W.Select
Set rngCell = ActiveCell


'Atribui o caminho da pasta e das imagens
strFolder = "C:\Users\Admin\Pictures\Stack\"
strFileName = Dir(strFolder & Nome & ".jpg", vbNormal)

'Busca a imagem
Set objPic = ActiveSheet.Pictures.Insert(strFolder & strFileName)
objPic.Name = Nome

'Formata a imagem de acordo com o tamanho da célula
 With objPic
    
        .Left = rngCell.Left
        .Top = rngCell.Top
        .Height = rngCell.Height
        .Placement = xlMoveAndSize
    
    End With

End Function

I hope it helps!

Any problems, let me know!