Excel Formulário com Imagem com base em ID

[Eri França]

Bom dia!

o código abaixo trás as informações de descrição, quantidade. numeração, lançamento, licenciadora, valor e imagem com base no que for lançado em Código do produto, porém a imagem não está vindo.

Agradeço qualquer ajuda

 

 

Private Sub ID_Exit(ByVal Cancel As MSForms.ReturnBoolean)

On Error GoTo ERRO01:

 

Columns("A:A").Select

Selection.Find(What:=ID.Value, After:=ActiveCell, LookAt:=xlWhole).Activate

Produto.Value = ActiveCell(1, 2).Value

lbl_numeração = ActiveCell(1, 3).Value

lbl_lançamento = ActiveCell(1, 4).Value

lbl_licenciadora = ActiveCell(1, 5).Value

lbl_valor_unit = Format(ActiveCell(1, 8).Value, "###,##0.00")

 

Exit Sub

 

ERRO01:

MsgBox "Produto não cadastrado."

End Sub

Function retornaProduto(ByVal vCodigo As String)

'Desabilitamos a atualização de tela

Application.ScreenUpdating = False

'Selecionamos a Planilha que contém a base de dados

With ThisWorkbook.Sheets("Gibis")

.Activate

'Seleciona a Coluna onde os ID's estão cadastrados

Columns(1).Select

'Se houver erro, vá para o tratamento

On Error GoTo ND

'Pesquisamos pelo código informado

Selection.Find(vCodigo, ActiveCell, xlValues, xlWhole, xlByRows, xlNext).Activate

'Gravamos ou atualizamos o caminho completo da Imagem na coluna L

Cells(ActiveCell.Row, "L") = CStr(ThisWorkbook.Path & "\Imagens\Gibis\" & vCodigo & ".jpg")

'Seleciona a célula onde o produto foi localizado

Cells(ActiveCell.Row, "A").Select

'Preenchemos os campos do UserForm

With Busca

.ID = vCodigo

.Produto = Cells(ActiveCell.Row, "B")

.Image1.PictureSizeMode = fmPictureSizeModeStretch

.Image1.Picture = LoadPicture(Cells(ActiveCell.Row, "L"))

End With

ND:

If Err = 91 Then 'Se o erro for 91 (não encontrado), informamos sobre o erro

MsgBox "O produto " & vCodigo & " não existe ou não foi cadastrado!", vbCritical, "Erro"

'E limpamos o formulário

Busca.ID = ""

Busca.Produto = ""

Busca.Image1.Picture = Nothing

End If

End With

'Habilitamos a atualização de tela

Application.ScreenUpdating = True

End Function