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