Sub InsertImagesInColumnG()

Dim folderPath As String

Dim Filename As String

Dim imgRow As Long

Dim ws As Worksheet

Dim picture As Shape

Dim fd As FileDialog

Dim topPosition As Double

Dim firstImageRow As Long ' To track the row of the first imported image

Dim firstPicture As Shape ' To track the first imported image

' Set the worksheet where images will be inserted

Set ws = ThisWorkbook.Sheets("Sheet1")

' Close the UserForm if it is already open

CloseUserFormIfOpen

' Delete existing images but exclude shapes with Rounded Corners

For Each picture In ws.Shapes

If picture.AutoShapeType <> msoShapeRoundedRectangle Then

picture.Delete

End If

Next picture

' Clear filenames in column I and reset headers

' ws.Columns("I").ClearContents

ws.Columns("I:M").ClearContents

ws.Cells(4, 7).Value = "Image" ' Header for images in column G

ws.Cells(4, 9).Value = "Filename" ' Header for filenames in column I

ws.Rows(4).Font.Bold = True ' Make headers bold

' Set column width for column G

ws.Columns("G").ColumnWidth = 12.14

' Set column width for column I and enable wrap text

' ws.Columns("I").ColumnWidth = 200 / 7.5 ' Set width to 200px (Excel column width is in characters, not pixels)

ws.Columns("I").ColumnWidth = 50 ' Set width to 50

ws.Columns("I").WrapText = True

' Open a dialog box to select the folder

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

With fd

.Title = "Select Folder Containing Images"

.AllowMultiSelect = False

If .Show = -1 Then ' If the user selects a folder

folderPath = .SelectedItems(1)

Else

MsgBox "No folder selected. Operation canceled.", vbExclamation

Exit Sub

End If

End With

' Ensure the folder path ends with a backslash

If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

' Initialize the starting position

imgRow = 5

topPosition = ws.Cells(imgRow, 7).Top ' Starting position in column G

firstImageRow = 0 ' Initialize to ensure we track the first image row

' Get the first image file in the folder

Filename = Dir(folderPath & "*.*")

' Loop through all image files in the folder

Do While Filename <> ""

' Check if the file is an image

If LCase(Filename) Like "*.jpg" Or LCase(Filename) Like "*.jpeg" Or LCase(Filename) Like "*.png" Or LCase(Filename) Like "*.bmp" Or LCase(Filename) Like "*.gif" Then

' Insert the image into the worksheet as a Shape object

Set picture = ws.Shapes.AddPicture(folderPath & Filename, _

msoFalse, msoCTrue, _

ws.Cells(imgRow, 7).Left, _

topPosition, _

64, 64)

' Move the image 1.2 pixels to the right

picture.Left = picture.Left + 1.2

' Track the first imported image and its row

If firstImageRow = 0 Then

firstImageRow = imgRow

Set firstPicture = picture

End If

' Set row height to 64.5 for the current row

ws.Rows(imgRow).RowHeight = 64.5

' Add the image name (without the folder path) in column I

ws.Cells(imgRow, 9).Value = Filename

' Center the filename height-wise in column I

ws.Cells(imgRow, 9).VerticalAlignment = xlCenter

' Move the top position down for the next image

topPosition = topPosition + 64 + 0.5 ' Add a 0.5-pixel gap between images

' Increment the row for the next image

imgRow = imgRow + 1

End If

' Get the next file in the folder

Filename = Dir

Loop

' Set the row height of the first imported image to 66

If firstImageRow > 0 Then

ws.Rows(firstImageRow).RowHeight = 66

End If

' Move the first picture 0.5 points down

If Not firstPicture Is Nothing Then

firstPicture.Top = firstPicture.Top + 0.5

End If

' Notify the user

MsgBox "Headers added. Column I set to 50 width with text wrapping. All images have been inserted in column G, and their names are listed and centered in column I.", vbInformation

End Sub