Carregar Imagem de ...
 
Notifications
Clear all

Carregar Imagem de Diretório

2 Posts
1 Usuários
0 Reactions
1,103 Visualizações
(@ccaciano)
Posts: 0
New Member
Topic starter
 

Eu tenho um diretório em uma célula e preciso carregar a imagem desse diretório em um formulário, porém o código abaixo da erro.
Alguém pode me ajudar?

Exemplo: Celula A1 tem a seguinte informação
"C:/Imagem.jpeg"

Sub TEMP_IMG()
Dim IMG
IMG = PastaTrabalho.Sheets("FERRAMENTA").Range("F2")
UserForm1.IMG_PRODUTO.Picture = LoadPicture(IMG)
End Sub
 
Postado : 30/12/2016 1:05 pm
(@ccaciano)
Posts: 0
New Member
Topic starter
 

Consegui resolver a situação com o Código abaixo.

O código abaixo abre uma aplicação de Pesquisa de arquivos com parâmetro de extensões de imagens pré definidas por mim, depois captura o caminho dessa imagem e coloca em uma TextBox, depois carrega a imagem em um formulário.

Essa imagem fica salva em uma célula no excel, onde o usuário não tem acesso, e quando ele acessa o cadastro e consulta o código do produto, se houver uma imagem cadastrada pra esse produto, a mesma é carregada a partir da célula onde está destinado os Diretórios de imagens.

Sub CARREGAR_DIRETORIO()
Dim Fd As Object
Dim x As String

'Define a caixa de diálogo como seleção de pasta(s)
Set Fd = Application.FileDialog(1)

'Define as propriedades da caixa de diálogo
With Fd
'Nome do botão de confirmação
.ButtonName = "Abrir"
'Título da caixa de diálogo
.Title = "Selecione a foto do produto..."
.Filters.Clear
.Filters.Add "Imagens", "*.bmp; *.jpg; *.jpeg", 1

'Caso este método retorne Verdadeiro significa que o usuário selecionou uma pasta
If .Show Then

'Retorna o caminho da pasta para a função
SelecionarPasta = .SelectedItems(1)
x = SelecionarPasta

'SELECIONA TODO O DIRETÓRIO DO ARQUIVO
Diretorio = x
xProduto.caminho_txt.Text = Diretorio


End If
End With

If xProduto.caminho_txt <> "" Then
CaminhoCad = xProduto.caminho_txt
xProduto.IMG_PRODUTO.Picture = LoadPicture(CaminhoCad)
xProduto.IMG_PRODUTO.Visible = False
xProduto.IMG_PRODUTO.Visible = True
End If

'Finaliza o objeto
Set Fd = Nothing
End Sub
 
Postado : 10/01/2017 1:25 pm