VBA Code Question on Photo Insert Automation

Question

Hi,

So I needed to match the pictures next to the SKUs and it worked except by like line 60 the photos start getting misaligned. I tried everything but I don't know why it does this. The photos are all the same size and I formatted the cells all the same size as well, but it keeps getting misaligned.

Also side question, I have an excel with over 2000 photos and it takes so long to load when I delete one line for example. Is it because the photos are over the cell and not inserted? How can I make it load faster, I checked and the macro is not in VBA and I have no formulas in the excel.

    Dim ws As Worksheet

    Dim imgPath As String

    Dim cell As Range

    Dim img As Picture

    Dim fileName As String

    Dim folderPath As String

    ' Set the worksheet and folder path

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

    folderPath = "C:\Users" ' Adjust the path as needed

      ' Debug info

    Debug.Print "Folder path: " & folderPath

    Debug.Print "File extension: " & fileExt = ".jpg"

    ' Loop through cells in Column B (assuming SKUs are in Column B)

    For Each cell In ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)

        fileName = Dir(folderPath & Left(cell.Value, 7) & "*.jpg") ' Adjust the number of characters to match

        If fileName <> "" Then

            imgPath = folderPath & fileName

            Set img = ws.Pictures.Insert(imgPath)

            With img

                .ShapeRange.LockAspectRatio = msoFalse

                .Top = cell.Offset(0, -1).Top

                .Left = cell.Offset(0, -1).Left

                .Width = 50 ' Adjust the width as needed

                .Height = 50 ' Adjust the height as needed

            End With

        End If

    Next cell

End Sub

Answer 1

Try this one.

With img
    .ShapeRange.LockAspectRatio = msoFalse
    .Top = cell.Top
    .Left = cell.Offset(0, -1).Left
    .Width = cell.Width
    .Height = cell.Height
    .Placement = xlMoveAndSize
End With