Automating "Place in Cell" for Pictures Inserted in Excel Using VBA, Formula or Other Tools

Question

Hello Excel experts!

I’m currently working on a project that involves inserting images into Excel sheets. I use Kutools' "Insert Pictures from Path (URL)" feature to quickly add images from URLs or file paths into my workbook. While this feature works great, it inserts all images as "Place Over Cell," requiring me to manually click each image, then go to the menu and select "Place in Cell."

The Problem:

This manual process is extremely time-consuming, especially when dealing with hundreds of images. I’d like to automate the process so that:

1. The script checks if the URL column (D) is not blank.
2. For each corresponding image inserted in column (B), it ensures the image is placed in the cell rather than over it.

Desired Outcome:

• All images should fit within their respective cells (B), and adjust automatically when rows or columns are resized.

Current Setup:

• Kutools to insert pictures from URLs in column (B)
• URL references are stored in column (D)

What I’ve Tried:

• I looked into some VBA solutions but haven’t found a clear method to programmatically replicate the "Place in Cell" option for pictures.

Request:

• Does anyone know a VBA script or another tool/approach to automate this task?
• Any resources or examples would be greatly appreciated!

Thanks in advance for your help!

Tarsha

Answer 1

Here are two variations.

The first one inserts the image into the cells.

Sub InsertImages()
    Const URLCol = "D"
    Const ImgCol = "B"
    Const FirstRow = 2
    Dim LastRow As Long
    Dim CurRow As Long
    Application.ScreenUpdating = False
    LastRow = Cells(Rows.Count, URLCol).End(xlUp).Row
    On Error Resume Next
    For CurRow = FirstRow To LastRow
        If Cells(CurRow, URLCol).Value <> "" Then
            ' for some reason, InsertPictureInCell works only for the active cell
            Cells(CurRow, ImgCol).Select
            Selection.InsertPictureInCell PictureURI:=Cells(CurRow, URLCol).Value
        End If
    Next CurRow
    Application.ScreenUpdating = True
End Sub

The second one inserts IMAGE formulas.

Sub InsertImages()
    Const URLCol = "D"
    Const ImgCol = "B"
    Const FirstRow = 2
    Dim LastRow As Long
    Dim CurRow As Long
    Application.ScreenUpdating = False
    LastRow = Cells(Rows.Count, URLCol).End(xlUp).Row
    On Error Resume Next
    For CurRow = FirstRow To LastRow
        If Cells(CurRow, URLCol).Value <> "" Then
            Cells(CurRow, ImgCol).Formula = "=IMAGE(""" & Cells(CurRow, URLCol).Value & """)"
        End If
    Next CurRow
    Application.ScreenUpdating = True
End Sub

Answer 2

The first one worked great, at first I kept getting an error but once I highlighted all of the rows in column B then executed it filled the cells with the pictures from the URL. Thank you very much!