Insert images automatically with VBA

5/5 - (1 vote)

Instructions for inserting images automatically for Excel with VBA, the most detailed and easy to do.

In particular, you can completely insert images from available image files on your computer or online image links.

Results after inserting pictures

See the following results:

chèn ảnh excel

Tuan will guide you to insert pictures into Excel files neatly, not distorted like other instructions on the Internet.



First, prepare a folder of images stored on your computer, or a list of links to the images you want to insert.

Next, insert two columns into your Excel file, the Image Link and the Status column to track the process of inserting the image.

In this example, Tuan will insert directly from the link to the image from the Internet.


You access VBA from Excel via Developer tab on Ribbon bar or the keyboard shortcut ALT + F11.

Create a new module and insert the code below, then close the VBA window.

					'TODO: Automatically add image to the cell
'Using: insertImage(Destination, Image Path)
Option Explicit

Function insertImage(dest As Range, imgPath As Range) As String
    InsertPicture imgPath, dest, True
    If isContainedImage(dest) Then
        insertImage = "OK!"
        Exit Function
    End If
    insertImage = "Failed!"
End Function

Private Function AutoPicture(rPath As Range)
    Dim ca  As Range
    Set ca = Application.Caller
    AutoPicture = InsertPicture(rPath, Application.Caller, False)
End Function

Private Sub ClearPicture(rrg As Range, isSubCall As Boolean)
    Dim Ws As Worksheet
    Dim pPics As Pictures
    Dim pPic As Picture
    On Error Resume Next
    Set Ws = rrg.Worksheet
    If isSubCall = True Then
        Set pPics = Ws.Pictures
        For Each pPic In pPics
            If Not (Application.Intersect(rrg, pPic.TopLeftCell) Is Nothing) Then
                If Not (Application.Intersect(rrg, pPic.BottomRightCell) Is Nothing) Then
                End If
            End If
        Dim rIndex As Range
        For Each rIndex In rrg
            Set pPic = Ws.Shapes(rIndex)
    End If
End Sub

Private Function InsertPicture(rS As Range, rD As Range, Optional isSubCall As Boolean = True)
    Dim lRows As Long
    Dim lCols As Long
    Dim lRow As Long
    Dim lCol As Long
    Dim rrg As Range
    Dim Pic As Shape
    Dim Ws As Worksheet
    Set Ws = rD.Worksheet
    lRows = rS.Rows.Count
    lCols = rD.Columns.Count
    If rS.Rows.Count <> rD.Rows.Count Or rS.Columns.Count <> rD.Columns.Count Then InsertPicture = CVErr(xlErrNA): Exit Function
    On Error Resume Next
    ClearPicture rD, True
    Dim vKQ() As Variant
    ReDim vKQ(1 To lRows, 1 To lCols) As Variant
    For lRow = 1 To lRows
        For lCol = 1 To lCols
            Set rrg = rD(lRow, lCol)
            Set Pic = Ws.Shapes.AddPicture(rS(lRow, lCol), msoFalse, msoTrue, 1, 1, -1, -1)
            If Err.Number <> 0 Then
                vKQ(lRow, lCol) = CVErr(xlErrNA)
                vKQ(lRow, lCol) = Pic.Name
                Pic.Placement = xlMoveAndSize
                ReSizeShape Pic, rrg
            End If
    Next lRow
    InsertPicture = vKQ
End Function

Private Sub ReSizeShape(a As Shape, rrg As Range)
    Dim shr As Single
    Dim swr As Single
    Dim sha As Single
    Dim swa As Single
    Dim sTyLe As Single
    a.LockAspectRatio = msoFalse
    a.ScaleHeight 1, msoTrue, msoScaleFromMiddle
    a.ScaleWidth 1, msoTrue, msoScaleFromMiddle
    shr = rrg.MergeArea.Height
    swr = rrg.MergeArea.Width
    sha = a.Height
    swa = a.Width
    sTyLe = 10
    If (shr / swr) >= (sha / swa) Then
        a.Width = swr * (100 - sTyLe) / 100
        a.Height = (a.Width * sha) / swa
        a.Height = shr * (100 - sTyLe) / 100
        a.Width = (a.Height * swa) / sha
    End If
    a.Left = rrg.Left + (swr - a.Width) / 2
    a.Top = rrg.Top + (shr - a.Height) / 2
    a.LockAspectRatio = msoTrue
End Sub

Function isContainedImage(r As Range) As Boolean
    Dim wShape As Shape

    For Each wShape In ActiveSheet.Shapes
        If wShape.TopLeftCell = r Then
            isContainedImage = True
            isContainedImage = False
        End If
    Next wShape
End Function


Back in the spreadsheet, in cell D3, enter the following formula:

					=insertImage(A3, C3)

In there,

  • A3: is the cell where you will store the image
  • C3: contains a link to an image

Note: for those of you inserting images from Folders on your computer, your path will have the following form:


Please save the image name with the product code for easy identification.

After pressing Enter, you will get the following output:

chèn ảnh excel

If the link fails, you will get the status marked as Failed!

Then flash fill down the remaining cells to get the same result as the beginning of the article.


After the fill is flashed, use the Shift + F10 + V key combination to paste the value, to avoid the formula running again, which will consume resources and time if you insert many images.

Code doesn't work on Excel 2016 version, you can use it well on Excel 2013 / 2019 / 2021 and Excel 365.

Above is an introductory article as well as a guide to inserting images into Excel using VBA.

Wish you success in applying to work or study!

Leave a Reply