Importar imagens em planilhas Excel VBA

Gráfico comparativo de linhas capa
Gráfico comparativo de linhas – Exemplo Brasileirão 2018 1º turno
28 de agosto de 2018
Técnica para agrupar dados em análises no Excel capa
[Excel] Agrupar e classificar situações iguais
30 de setembro de 2018

Importar imagens em planilhas Excel VBA

Neste artigo é demonstrado como importar imagens em planilhas do Excel com VBA.

O exemplo foi enviado por Marco Gonzaga e o código VBA para importar no Excel imagens pelo amigo Rodrigo Sant’Anna Lima. Obrigado pela sua colaboração.

Na planilha exemplo temos um relatório de brigada de incêndio para a passagem do turno. Veja mais artigos também em https://www.guiadoexcel.com.br/vba/

Impoartar imagens automaticamente no Excel com VBA

Importar Imagens no Excel automaticamente com VBA

Na animação abaixo temos a importação das imagens no Excel, basta clicar no botão para importar as imagens e selecionar os arquivos.

Importar imagens em planilhas Excel VBA

No relatório de passagem de turno da brigada é necessário importar as fotos dos locais auditados na empresa.

Por meio do seguinte código VBA é realizada a importação das fotos para a pasta de trabalho Excel.

 

Sub Carregar_AutoImagens_Passagem_Serviço_Gocil()

    Dim Pict
    Dim ImgFileFormat As String
    Dim Celula As String
    Celula = "A95"    ' celula que será inserido a imagem
    ImgFileFormat = "Image Files JPEG (*.jpeg),*.jpeg,Image Files JPG (*.jpg),*.jpg, Image Files PNG (*.png),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"
    
    'Pict = Application.GetOpenFilename(ImgFileFormat, False, False, MultiSelect:=True)
    
    Pict = Application.GetOpenFilename(ImgFileFormat, False, False, False, True)
    
    'If Pict = False Then End
    
    If IsArray(Pict) Then 'IF ARRAY
    
        If UBound(Pict) <= 22 Then 'IF I
        
            j = 1
    
            For i = LBound(Pict) To UBound(Pict) 'FOR I
            
                Select Case i 'Cobertura de 22 imagens
                
                    Case 1 To 3
                        'IMAGEM: largura = 4 colunas; altura= 11 linhas
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
                        Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
                        
                        j = j + 4
                        Celula = Chr(64 + j) & "95"
                                       
                    
                    Case 4 To 6
                        If Mid(Celula, 1, 1) = "M" Then
                            j = 1
                            Celula = Chr(64 + j) & "107"
                        End If
                        'IMAGEM: largura = 6 colunas; altura= 11 linhas
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
                        Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
                        
                        j = j + 4
                        Celula = Chr(64 + j) & "107"
                        
                        
                        Case 7 To 9
                        If Mid(Celula, 1, 1) = "M" Then
                            j = 1
                            Celula = Chr(64 + j) & "119"
                        End If
                        'IMAGEM: largura = 4 colunas; altura= 11 linhas
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
                        Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
                        
                        j = j + 4
                        Celula = Chr(64 + j) & "119"
                    
                    
                     Case 10 To 12
                        If Mid(Celula, 1, 1) = "M" Then
                            j = 1
                            Celula = Chr(64 + j) & "131"
                        End If
                        'IMAGEM: largura = 4 colunas; altura= 11 linhas
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
                        Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
                        
                        j = j + 4
                        Celula = Chr(64 + j) & "131"
                      
                      
                      Case 13 To 15
                        If Mid(Celula, 1, 1) = "M" Then
                            j = 1
                            Celula = Chr(64 + j) & "143"
                        End If
                        'IMAGEM: largura = 4 colunas; altura= 11 linhas
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
                        Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
                        
                        j = j + 4
                        Celula = Chr(64 + j) & "143"
                        
                        
                        Case 16 To 18
                        If Mid(Celula, 1, 1) = "M" Then
                            j = 1
                            Celula = Chr(64 + j) & "155"
                        End If
                        'IMAGEM: largura = 4 colunas; altura= 11 linhas
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
                        Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
                        
                        j = j + 4
                        Celula = Chr(64 + j) & "155"
                        
                        
                        Case 19 To 21
                        If Mid(Celula, 1, 1) = "M" Then
                            j = 1
                            Celula = Chr(64 + j) & "167"
                        End If
                        'IMAGEM: largura = 4 colunas; altura= 11 linhas
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
                        Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
                        
                        j = j + 4
                        Celula = Chr(64 + j) & "167"
                        
                         

                End Select

            Next i 'FOR I
        
        Else 'IF I
        
            MsgBox "Selecionar apenas 22 imagens"
           
            
            End
        
        End If 'IF I
    
    End If 'IF ARRAY
    
    
    'If Pict = False Then End
    'Application.ActiveSheet.Shapes.AddPicture Pict, False, True, Range(Celula).Left, _
    'Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11    'IMAGEM: largura = 30 colunas; altura= 13 linhas
End Sub

A planilha está disponível para download ao final do artigo e você poderá adaptar o código como precisar.

O sistema faz um loop pelas imagens que devem ser importadas e as coloca lado a lado nas células do Excel e ajusta as mesmas para encaixarem nas células corretamente.

Abraço

Marcos Rieper


Clique aqui e leia mais sobre Excel VBA. https://www.guiadoexcel.com.br/vba/ O Guia do Excel foi criado por Marcos Rieper e oferece artigos, dicas, tutoriais e modelos de planilhas prontas. Aqui você encontra tudo sobre Excel, seja de nível básico, intermediário,  avançado e VBA. O Guia do Excel oferece diversos materiais completamente gratuitos para download. Navegue em nosso site e confira! Conheça também a nossa Loja do Excel https://loja.guiadoexcel.com.br/
Cursos

Curso Excel Básico – 1 ano de acesso

R$99,00

COMPRAR
Cursos

Curso Excel Completo – Curso Excel Básico + Curso Excel Avançado – Acesso Vitalício

R$218,00 R$179,00

COMPRAR
Cursos

Curso Excel Master – Curso Excel Básico + Curso Excel Avançado + Curso VBA Excel + LP – Acesso Vitalício

R$357,00 R$249,00

COMPRAR
Cursos

Curso Excel PRO – Curso Excel Avançado + Curso VBA Excel + Lógica de programação – Acesso Vitalício

R$258,00 R$199,00

COMPRAR

1 Comentário

  1. Diogo disse:

    Não entendo bem de VBA, sou amador, gostaria que fosse 2 fotos, 2 em 2 ao invés de 3 por linhas, alguem poderia ajudar

Deixe uma resposta

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *

This site uses Akismet to reduce spam. Learn how your comment data is processed.

Inscreva-se no nosso canal do Youtube!


Junte-se ao nosso canal do Youtube. Começamos em abril de 2016, mas já temos mais de 06:00 h de treinamentos gratuitos e este número irá aumentar. Vídeos novos todos os sábados.