Hey Vera, let's sort out this image placement issue in your VBA code. The root problem right now is how you're mapping images to cells—your current loop puts the same image in both columns of each row, which isn't what you want. Let's adjust the logic to get that A1=img1, B1=img2, A2=img3, B2=img4 behavior you're after.

What's Wrong with the Original Code? #

Your outer loop iterates over each image index i, then the inner loop inserts that same DirectoryList(i) image into both columns j=0 and j=1 of row i+1. That's why every row has duplicate images. We need to reindex how we pull images from the array to pair them into rows of two.

Corrected Code #

Here's the revised version with key fixes and improvements:

Sub ReadFolder()
' ReadFolder - Insert images into A/B columns in row pairs (A1=img1, B1=img2, A2=img3, etc.)
Dim File As Variant
Dim Counter As Long
Dim DirectoryList() As String
Dim varResp As Variant
Dim picShape As Excel.Shape ' Renamed to avoid conflict with "File" variable
Dim i As Long, j As Long
ReDim DirectoryList(1000)

' 检查用户是否输入了有效路径，或者是否取消操作，并提供终止或重试的选项
lblTryAgain:
varResp = InputBox("Type down the files path)", "Path")
If Trim(varResp) = "" Then
    If MsgBox("Do you wish to abort?", vbYesNo + vbQuestion, "Abort?") = vbYes Then
        GoTo lblExit
    Else
        GoTo lblTryAgain
    End If
Else
    File = Dir$(varResp & "\*.*")
    If File = "" Then
        MsgBox "The path doesn't exist, Please retry", vbExclamation, "Fail"
        GoTo lblTryAgain
    End If
End If

On Error GoTo Erro

' 将文件夹中的文件填充到数组中（保存完整路径，避免插入图片时出错）
Do While File <> ""
    DirectoryList(Counter) = varResp & "\" & File
    File = Dir$
    Counter = Counter + 1
Loop

' 根据数组中填充的元素数量调整数组大小
If Counter > 0 Then
    ReDim Preserve DirectoryList(Counter - 1)
Else
    MsgBox "No files found in the specified path.", vbInformation, "Info"
    GoTo lblExit
End If

' 在插入新图片前删除工作表中的现有图片
For Each picShape In Worksheets("Sheet1").Shapes
    picShape.Delete
Next

' 遍历数组，将图片按A1、B1、A2、B2的顺序插入，并调整格式
For i = 0 To (UBound(DirectoryList) \ 2)
    For j = 0 To 1
        ' 计算当前单元格对应的图片索引：行号*2 + 列偏移
        Dim imgIndex As Long
        imgIndex = (i * 2) + j
        
        ' 如果索引超出数组范围，停止插入（处理图片数量为奇数的情况）
        If imgIndex > UBound(DirectoryList) Then Exit For
        
        With Worksheets("Sheet1").Cells(i + 1, j + 1)
            Set picShape = Worksheets("Sheet1").Pictures.Insert(DirectoryList(imgIndex))
            picShape.Top = .Top
            picShape.Left = .Left
            picShape.ShapeRange.LockAspectRatio = msoFalse
            picShape.Placement = xlMoveAndSize
            .ColumnWidth = 30
            .RowHeight = 100
            picShape.ShapeRange.Width = 170
            picShape.ShapeRange.Height = 100
        End With
    Next j
Next i

lblExit:
Exit Sub

Erro:
MsgBox "OOpssie, Fail! Error: " & Err.Description, vbCritical, "Error"
End Sub

Key Fixes & Improvements #

1. Full Path Storage: Your original code only stored filenames in DirectoryList, which would cause errors when inserting images (unless Excel was already in the target folder). Now we save the full path to ensure images are found reliably.
2. Image Index Calculation: We use imgIndex = (i * 2) + j to map each row/column pair to the correct image. For row 1 (i=0), j=0 gives index 0 (first image), j=1 gives index 1 (second image); row 2 (i=1) gives indexes 2 (third) and 3 (fourth), etc.
3. Out-of-Bounds Check: The If imgIndex > UBound(DirectoryList) Then Exit For line prevents errors when there's an odd number of images, stopping insertion once all images are placed.
4. Variable Name Conflict: Renamed the shape variable from File to picShape to avoid clashing with the File variant used for directory listing.
5. Empty Folder Handling: Added a check to notify you if no files are found in the specified path.

Testing This Code #

• 4 images: A1=img1, B1=img2, A2=img3, B2=img4
• 5 images: A1=img1, B1=img2, A2=img3, B2=img4, A3=img5 (B3 remains empty)
• Any number of images (even or odd) will be handled gracefully.

内容的提问来源于stack exchange，提问作者Vera