Inserir Imagens em Células no Excel com VBA

Como inserir imagens em células no Excel com VBA automaticamente. Código pronto para automatizar inserção de imagens.

Inserir Imagens na Célula do Excel

O Excel permite que sejam inseridas imagens em suas células.

Para Inserir Imagens nas células do Excel clique na guia Inserir->Imagens->Colocar na Célula e selecionar a origem da qual será importada a imagem.

E à partir das imagens importadas podemos utilizar em fórmulas e tabelas dinâmicas de uma forma muito prática.

Neste sentido criamos um código VBA que insere automaticamente as imagens nas células no Excel.

Este procedimento também pode ser feito manualmente selecionando as imagens todas da pasta e ao clicar no botão de inserir imagens ele insere todas de uma vez só automaticamente.

Código VBA Para Inserir Imagens em Células com VBA

Sub InserirImagens()
    Dim folderPath  As String
    Dim fileName    As String
    Dim filePath    As String
    Dim ws          As Worksheet
    Dim cell        As Range
    Dim row         As Long
    Dim col         As Long
    
    ' Defina o caminho da pasta contendo as imagens
    folderPath = fnSelecionarPasta
    
    ' Defina a planilha onde as imagens serão inseridas
    Set ws = ActiveSheet
    
    ' Defina a linha e coluna inicial
    row = ActiveCell.row
    col = ActiveCell.Column
    
    ' Obtenha o primeiro arquivo .png na pasta
    fileName = Dir(folderPath & "*.png")
    
    Do While fileName <> ""
        ' Defina o caminho completo do arquivo de imagem
        filePath = folderPath & fileName
        
        ' Defina a célula onde a imagem será inserida
        Set cell = ws.Cells(row, col)
        
        ' Selecione a célula
        cell.Select
        
        ' Insira a imagem na célula selecionada
        Selection.InsertPictureInCell filePath
        
        ' Aumente a linha para a próxima célula
        row = row + 1
        
        ' Obtenha o próximo arquivo .png na pasta
        fileName = Dir
    Loop
End Sub

Public Function fnSelecionarPasta() As String
    On Error GoTo TratarErro
 
    Dim fdlg As FileDialog
     
    Set fdlg = Application.FileDialog(msoFileDialogFolderPicker)
     
    If fdlg.Show = -1 Then
        fnSelecionarPasta = fdlg.SelectedItems(1) & "\"
    Else
        MsgBox "Não foi selecionada uma pasta."
    End If
     
Sair:
    Exit Function
TratarErro:
    MsgBox "Houve um erro na aplicação: " & Err.Description & " - " & Err.Number
    GoTo Sair
End Function

Download da Planilha Inserir Imagens em Células VBA

Para realizar o download desta planilha de exemplo clique no botão abaixo.