DiegoVieira46

Perfeito meu amigo.

 

O código atendeu exatamente conforme eu precisava.

 

Muito obrigado. 

Boa tarde, prezados.

 

Utilizo uma fórmula VBA para inserir um código em uma linha e ele me trazer uma imagem local armazenada em meu computador. O recurso funciona bem, porém necessito repetir o código em alguns oportunidades, porém a imagem não se mantém na célula. Para facilitar o entendimento, segue cenário que ocorre e cenário que preciso. 

 

Podem me auxiliar, por gentileza?

 

Necessito que ao inserir um mesmo código em outra linha, a imagem seja exibida corretamente em todas as linhas.

 

Utilizo o código abaixo:

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