Importar imagens em planilhas Excel VBA - Planilha importar imagens Gratuita

É possível inserir imagens no Excel, isso todos sabemos. Mas como importar imagens em planilhas Excel de forma automática? Com VBA isso é possível.

Neste artigo e também na vídeo-aula, explico como a podemos realizar esta tarefa com um exemplo de um Relatório de Brigada de incêndio.

Este 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.

Relatório de Brigada de Incêndio Excel

O nosso exemplo foi criado com base em um relatório de brigada de incêndio que existe internamente em muitas empresas.

O objetivo deste relatório é realizar uma avaliação dos equipamentos de segurança, registrar ocorrências e evidenciar as situações por meio de fotografias.

Esta planilha está pronta e disponível no download ao final da página, inclusive com o código fonte liberado.

Ela pode ser facilmente adaptada para Relatório da CIPA Excel ou qualquer outro relatório ou situação que necessite de evidências com fotos.

Importar Imagens no Excel automaticamente com VBA

O sistema permite que a integração seja realizada automaticamente conforme abaixo.

Basta clicar no botão de Inserir Imagens para que as imagens sejam inclusas em cada uma das células.

No exemplo são permitidas até 22 imagens, mas pode ser facilmente ajustado para que importe mais imagens, o importante é entender bem o processo.

No VBA há várias técnicas envolvidas:

• Selecionar pasta
• Importar imagens por célula
• Ajustar cada uma das imagens no tamanho de cada uma das células

Importar Imagens para o Excel automaticamente com VBA

Se você já entende de VBA, veja o código abaixo. Ele é o procedimento que realiza a importação das imagens automaticamente para as células utilizando VBA.

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
End Sub

Entendendo o VBA de importação de imagens no Excel

Na parte do código abaixo a variável do tipo String recebe os tipos de campos que serão exibidos quando a pasta for selecionada. Isto é importante porque se houverem outros arquivos na pasta, apenas arquivos destas extensões serão importados.

  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"

O código abaixo realiza a abertura da pasta do janela do Windows para selecionar arquivos.

  Pict = Application.GetOpenFilename(ImgFileFormat, False, False, False, True)

Na linha de código abaixo nós temos a verificação se foram selecionadas imagens da pasta.

  If IsArray(Pict) Then

No ponto abaixo é então iniciado o Loop entre entre todas as imagens do array VBA

  For i = LBound(Pict) To UBound(Pict)

E neste ponto abaixo nós temos a adição das imagens em cada uma das células com a definição dos tamanhos de acordo com o tamanho de cada uma das células.

Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11

Download da Planilha

Para o download da planilha de importação de imagens Excel com VBA basta preencher o formulário e fazer parte da nossa newsletter gratuita.

Abraço

Marcos Rieper

Curso Excel Completo – Do Básico ao VBA

Quer aprender Excel do Básico, passando pela Avançado e chegando no VBA? Clique na imagem abaixo: