none
Busca e Exibição de imagem RRS feed

  • Pergunta

  • Saudações!

    1- Tenho duas planilhas no Excell ( 1 e 2)

    2- Na Planilha 1 tenho o Código do produto e o endereço de onde a imagems esta armazenada.

    3- Na Planilha 2 (Planilha de Pesquisa) tenho uma celula onde digito o código do produto  e ele me traz A1 = Preço do produto

    A2 = quantidade em estoque, A13 endereço onde esta armazenado a imagem na planilha 1.

    Se possível gostaria que fosse me passado a aplicação do VBA que pudesse me mostrar a imagem relacionada ao código digitado

    Antecipadamente agradeço a disposição em ajudar e transmitir seu conhecimento!

    Muito Obrigado! 

     
    sábado, 25 de abril de 2015 16:21

Respostas

  • Tente isso:

    Sub TestInsertPictureInRange()
        Dim objFSO As Object
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Dim objFolder As Object
        Dim objFile As Object
        Dim i As Integer
        i = 1
        Set objFolder = objFSO.GetFolder("C:\Users\h162524\Desktop\")
        For Each objFile In objFolder.Files
            If InStrRev(objFile.Name, ".png") <> 0 Then
                InsertPictureInRange objFile.Path, Range("B" & i & ":C" & i)
                i = i + 1
            End If
        Next objFile
        
    End Sub
    
    Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
    ' inserts a picture and resizes it to fit the TargetCells range
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
        If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
        If Dir(PictureFileName) = "" Then Exit Sub
        ' import picture
        Set p = ActiveSheet.Pictures.Insert(PictureFileName)
        ' determine positions
        With TargetCells
            t = .Top
            l = .Left
            w = .Offset(0, .Columns.Count).Left - .Left
            h = .Offset(.Rows.Count, 0).Top - .Top
        End With
        ' position picture
        With p
            .Top = t
            .Left = l
            .Width = w
            .Height = h
        End With
        Set p = Nothing
    End Sub


    Att. Andre de Mattos Ferraz

    • Sugerido como Resposta André de Mattos Ferraz segunda-feira, 27 de abril de 2015 12:56
    • Marcado como Resposta Josiasweb segunda-feira, 27 de abril de 2015 20:41
    segunda-feira, 27 de abril de 2015 12:55

Todas as Respostas

  • se for em uma image faça basicamente assim:

    Private Sub Worksheet_Change(ByVal Target As Range)
    
        If Target.Address = "$A$1" Then
            
            Image1.Picture = LoadPicture(Range("B1").Value)
            
        End If
            
    End Sub


    Natan

    sábado, 25 de abril de 2015 17:36
  • Natan vou tentar te explicar melhor o que eu gostaria.

    Plan3 Cel A2=  Digito o Cód. do Produto ex, (10027)

    Plan3 Cel A12 = Carrega o endereço da Imagem do Produto ex. 

    (C:\Users\josias\Desktop\foto\10027. jpg)

    Preciso carregar esta imagem nesta mesma planilha.

    Não estou conseguindo com seu vb anterior.

    Vc poderia refaze por favor. Obrigado!!

    segunda-feira, 27 de abril de 2015 00:25
  • Josias,

    o que postei foi um exemplo de como poderias fazer isso, basta adaptá-lo a sua necessidade.

    Quando você diz que não conseguiu, gerou erro?


    Natan

    segunda-feira, 27 de abril de 2015 11:03
  • Nao gerou erro, mas a imagem nao aparece (ja coloquei minhas variaveis) pode estar acontecendo problemas com o arquivo de imagen!!
    segunda-feira, 27 de abril de 2015 12:46
  • Tente isso:

    Sub TestInsertPictureInRange()
        Dim objFSO As Object
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Dim objFolder As Object
        Dim objFile As Object
        Dim i As Integer
        i = 1
        Set objFolder = objFSO.GetFolder("C:\Users\h162524\Desktop\")
        For Each objFile In objFolder.Files
            If InStrRev(objFile.Name, ".png") <> 0 Then
                InsertPictureInRange objFile.Path, Range("B" & i & ":C" & i)
                i = i + 1
            End If
        Next objFile
        
    End Sub
    
    Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
    ' inserts a picture and resizes it to fit the TargetCells range
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
        If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
        If Dir(PictureFileName) = "" Then Exit Sub
        ' import picture
        Set p = ActiveSheet.Pictures.Insert(PictureFileName)
        ' determine positions
        With TargetCells
            t = .Top
            l = .Left
            w = .Offset(0, .Columns.Count).Left - .Left
            h = .Offset(.Rows.Count, 0).Top - .Top
        End With
        ' position picture
        With p
            .Top = t
            .Left = l
            .Width = w
            .Height = h
        End With
        Set p = Nothing
    End Sub


    Att. Andre de Mattos Ferraz

    • Sugerido como Resposta André de Mattos Ferraz segunda-feira, 27 de abril de 2015 12:56
    • Marcado como Resposta Josiasweb segunda-feira, 27 de abril de 2015 20:41
    segunda-feira, 27 de abril de 2015 12:55
  • Obrigado andreFuncionou perfeitamente! parabens.

    josiasweb

    segunda-feira, 4 de maio de 2015 00:01
  • Natan Obrigado, havia um erro de arquivo de imagem, seu cófigo estava Ok. Obrigado pela ajuda.

    josiasweb

    segunda-feira, 4 de maio de 2015 00:03