Macro to Insert Images For All Rows

InsertImagesForAllRows.xlsm

' Require Item numbers on Column A
' Enter base path when prompted

Sub InsertImagesForAllRows()
    Dim ws As Worksheet
    Dim imgPath As String
    Dim imgCell As Range
    Dim lastRow As Long
    Dim i As Long
    Dim basePath As String

    ' Prompt the user for the base path
    basePath = InputBox("Enter the base path for the images:", "Base Path", "C:\Users\rona\Downloads\bundled\")

    ' Check if the user provided a base path
    If basePath = "" Then
        MsgBox "No base path provided. Operation cancelled."
        Exit Sub
    End If

    ' Ensure the base path ends with a backslash
    If Right(basePath, 1) <> "\" Then
        basePath = basePath & "\"
    End If

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

    ' Find the last row with data in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Loop through each cell in column A
    For i = 1 To lastRow
        ' Get the image path from the filename in column A
        imgPath = basePath & ws.Cells(i, 1).Value & ".jpg" ' Change the extension if needed

        ' Set the cell where you want to insert the image
        Set imgCell = ws.Cells(i, 2) ' Change to your desired column

        ' Insert the image
        If Dir(imgPath) <> "" Then
            With ws.Pictures.Insert(imgPath)
                .ShapeRange.LockAspectRatio = msoFalse
                .Left = imgCell.Left
                .Top = imgCell.Top
                .Width = imgCell.Width
                .Height = imgCell.Height
            End With
        Else
            MsgBox "Image not found: " & imgPath
        End If
    Next i
End Sub