Olá Mariana!

Talvez o resultado que você quer pode ser feito sem VBA, através do recurso "Camera" que é nativo do Excel.

Leia o artigo que escrevi e veja se é possível aplicar o conceito na sua planilha.

Se puder poste um modelo da sua planilha para analisar melhor o problema.

http://social.technet.microsoft.com/wiki/pt-br/contents/articles/25613.utilizando-o-recurso-camera-do-excel-para-criar-relatorios-com-imagens-ou-graficos-alternaveis.aspx

Abraços!

Já cogitou a hipótese de se utilizar de um Form para tal finalidade, uma vez que ficaria mais pratico tanto carregar as imagens quanto para apresentação de itens e afins?

Oi Selmo.

Eu não sou expert em Excel... tudo o que faço eu vou aprendendo de tutorial... então meus conhecimentos acabam sendo um tanto superficial.

Não sei como seria esse "Form", poderia me dar o exemplo de como funciona?

Obrigada.

Olá Mariana!

Talvez o resultado que você quer pode ser feito sem VBA, através do recurso "Camera" que é nativo do Excel.

Leia o artigo que escrevi e veja se é possível aplicar o conceito na sua planilha.

Se puder poste um modelo da sua planilha para analisar melhor o problema.

http://social.technet.microsoft.com/wiki/pt-br/contents/articles/25613.utilizando-o-recurso-camera-do-excel-para-criar-relatorios-com-imagens-ou-graficos-alternaveis.aspx

Abraços!

Oi Issamu.

Obrigada pela resposta.

Eu li o artigo e até fiz um exemplo na minha planilha. E meio que funcionou. rsrs

Mas eu tenho mais de 200 itens nessa planilha. Pelo o que eu tendi eu não teria que nomear célula por célula, e como os nomes dos materiais utilizam caracteres especiais eu não sei como faria para que quando aparecesse o nome completo do produto também viesse a foto.

Estou enviando um exemplo da planilha.

Olá Mariana!

Analisei o seu arquivo e vi que seria possível utilizar o recurso da camera utilizando a função DESLOC ao invés de nomear os intervalos, porém haveria a necessidade de ter pré definido um campo de imagem para cada linha do resultado do seu filtro avançado. Se o resultado do filtro sempre for um produto serviria bem essa alternativa.

Para contornar esta limitação desenvolvi uma alternativa em VB para copiar a imagem de cada resultado do filtro.

Sub Trazer_Imagem()

Dim Nome As String

Application.Goto Range("C7")
Do Until ActiveCell.Value = ""

ActiveCell.Rows("1:1").EntireRow.RowHeight = 74.25

Nome = ActiveCell.Value

    Sheets("DADOS").Select
    Cells.Find(What:=Nome, After:= _
        ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 5).Range("A1").Select
    Selection.Copy

    Sheets("Catálogo").Select
    ActiveCell.Offset(0, 5).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, -5).Range("A1").Select

Loop

End Sub

E também foi necessário incluir um código na rotina de limpar para excluir as imagens:

    Dim Shp As Shape

'limpar todas imagens, exceto os botões filtro e limpar
For Each Shp In ActiveSheet.Shapes
Shp.Select
If Shp.Name <> "Button 1" And Shp.Name <> "Button 2" Then
    Shp.Delete
End If

Next Shp

Analise o arquivo e veja se assim atende sua necessidade.

Abs!

Olá Mariana!

Analisei o seu arquivo e vi que seria possível utilizar o recurso da camera utilizando a função DESLOC ao invés de nomear os intervalos, porém haveria a necessidade de ter pré definido um campo de imagem para cada linha do resultado do seu filtro avançado. Se o resultado do filtro sempre for um produto serviria bem essa alternativa.

Para contornar esta limitação desenvolvi uma alternativa em VB para copiar a imagem de cada resultado do filtro.

Sub Trazer_Imagem()

Dim Nome As String

Application.Goto Range("C7")
Do Until ActiveCell.Value = ""

ActiveCell.Rows("1:1").EntireRow.RowHeight = 74.25

Nome = ActiveCell.Value

    Sheets("DADOS").Select
    Cells.Find(What:=Nome, After:= _
        ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 5).Range("A1").Select
    Selection.Copy

    Sheets("Catálogo").Select
    ActiveCell.Offset(0, 5).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, -5).Range("A1").Select

Loop

End Sub

E também foi necessário incluir um código na rotina de limpar para excluir as imagens:

    Dim Shp As Shape

'limpar todas imagens, exceto os botões filtro e limpar
For Each Shp In ActiveSheet.Shapes
Shp.Select
If Shp.Name <> "Button 1" And Shp.Name <> "Button 2" Then
    Shp.Delete
End If

Next Shp

Analise o arquivo e veja se assim atende sua necessidade.

Abs!

Obrigada Issamu, funcionou perfeitamente!

Mas eu tenho que admitir que está difícil para mim entender como você fez isso! rs.

Eu não queria simplesmente copiar os meus dados para a planilha que você fez, eu queria poder entender e aplicar o que você fez na planilha completa que eu tenho.

Mas realmente não estou entendendo.

Se você pudesse explicar como você aplicou o desloc, em qual célula e tal... Eu agradeceria muito! Mas entendo se você não tiver o tempo para explicar o passo a passo.

De qualquer forma eu agradeço, e muito, pela ajuda!

Olá Mariana!

Você não conseguiu aplicar o modelo na sua base completa?

No meu modelo eu não apliquei o recurso câmera, pois acredito que não seria uma solução tão fácil, uma vez que o resultado do filtro pode gerar uma lista grande. A utilização da camera utizando a função DESLOC seria boa se você estivesse trabalhando com apenas um resultado no filtro.

Por isso eu modifiquei o código baseado na sua planilha. Se você copiar a sua base para a planilha dados, o filtro vai funcionar.

Eu dei uma nova olhada aqui e vi algumas possibilidade de melhorar o código. Infelizmente não vou conseguir postar agora arquivo xlsm, mas vou postar o código para você substituir no módulo 1:

Sub Filtro()
    '
    ' Filtro Macro
    '
    
    '
    Application.ScreenUpdating = False
    
    If Application.WorksheetFunction.CountIf(Range("C2:G2"), "") = 5 Then
        Beep
        MsgBox "Preencha algum critério para aplicar o filtro!", vbCritical
        Exit Sub
    End If
    
    Limpar
       
    Sheets("DADOS").Columns("A:F").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("C1:H2"), CopyToRange:=Range("C6:H6"), Unique:=False
    ActiveWindow.SmallScroll Down:=-9
    
    Trazer_Imagem
    
    Application.ScreenUpdating = True
    
End Sub
Sub Limpar()
    '
    ' Limpar Macro
    '
    
    '
    Range("C7:H" & Cells(Rows.Count, "C").End(xlUp).Row + 1).Select
    Selection.ClearContents
    Range("C7").Select
    
    Dim Shp As Shape
    
    'limpar todas imagens, exceto os botões filtro e limpar
    For Each Shp In ActiveSheet.Shapes
        Shp.Select
        If Shp.Name <> "Button 1" And Shp.Name <> "Button 2" Then
            Shp.Delete
        End If
        
    Next Shp
    
Range("C2").Activate
    
End Sub

Sub Trazer_Imagem()
    
    Dim Nome As String
    
    Application.Goto Range("C7")
    Do Until ActiveCell.Value = ""
        
        ActiveCell.Rows("1:1").EntireRow.RowHeight = 74.25
        
        Nome = ActiveCell.Value
        
        Sheets("DADOS").Select
        Cells.Find(What:=Nome, After:= _
        ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(0, 5).Range("A1").Select
        Selection.Copy
        
        Sheets("Catálogo").Select
        ActiveCell.Offset(0, 5).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(1, -5).Range("A1").Select
        
        Loop
        
End Sub

Oi Issamu! Boa tarde!

Eu não consegui replicar o que você fez na minha planilha, porque eu não sei como você fez, rs.

Eu apliquei, e ajustei, os meus dados na planilha que você enviou.

Eu queria entender como você usou a função desloc, onde você usou. E também tem umas outras macros no arquivo que não entendi bem a finalidade.

Eu só tive que alterar o código de limpar as imagens, porque não estava funcionando quando eu protegia a planilha de dados. Eu tinha um outro código aqui e utilizei ele.

Segue:

Sub RemoverImg()
On Error Resume Next
Dim img As Shape

For Each img In ActiveSheet.Shapes
    If Not Application.Intersect(img.TopLeftCell, ActiveSheet.Range("K5:K350")) Is Nothing Then
        img.Delete
    End If
Next
End Sub

Mas o importante é que a planilha está funcionando perfeitamente! Entretanto seria ótimo entender como você fez, caso eu tenha a necessidade de fazer algo parecido novamente.

Muito obrigada pela ajuda!