Hi ive been learning programming and VBA for about a month so far, and ive managed to develop a code which search images from a folder(chosen by the user) and put it into an column inside my excel thru some loops. The programn works fine. But now i moved on and im trying to work with multi-dimensional arrays and improve the code, so it can also insert images into multiple columns. So instead of putting the images only inside the column A im trying to make a loop so it also inserts the images inside columns A and B.

Heres wat ive achieved so far:

Sub ReadFolder()
'
'ReadFolder
'
Dim File As Variant
Dim Counter As Long
Dim DirectoryList() As String
Dim varResp As Variant
Dim shape as Excel.shape
ReDim DirectoryList(1000)

' check if the user inserted a valid path or if he canceled the operation and offer him a chance to abort the operation or retry 
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 doesnt exist , Please retry", vbExclamation, "Fail"
           GoTo lblTryAgain
        End If
  End If
On Error GoTo Erro

' fill the array with elements that are inside the file(gotta put then into a 2d array with the dimension (n,2)
Do While File <> ""
    DirectoryList(Counter) = File
    File = Dir$
    Counter = Counter   1
Loop
' resize the array accordingly to the number of elements filled inside it
ReDim Preserve DirectoryList(Counter - 1)

' delete the images inside the sheet before inserting new ones
For Each shape In Worksheets("Sheet1").Shapes
        shape.Delete
Next

' loop thru the array and put images into columns A and resize the  column, images and rows
For i = 0 To UBound(DirectoryList)
    for j = 0 to 1
       Debug.Print DirectoryList(i)
    With Worksheets("Sheet1").Cells(i 1, j 1)
       Set File = Worksheets("Sheet1").Pictures.Insert(DirectoryList(i))
                    
           File.Top = .Top
           File.Left = .Left
           File.ShapeRange.LockAspectRatio = msoFalse
           File.Placement = xlMoveAndSize
           .ColumnWidth = 30
           .RowHeight = 100
           File.ShapeRange.Width = 170
           File.ShapeRange.Height = 100
           
End With
    next j
Next i

lblExit:
    Exit Sub
Erro:
   MsgBox "OOpssie, Fail!", vbCritical, "Error"

End Sub

This code works, but not in the way i expected, im expecting it to do this(COnsidering the folder has only 4 images):

But im getting this instead:

Points to consider:

1. The last image .has changed cause i accidentaly deleted it(that doesnt interfere with the problen at all)
2. theres no way to tell exactly how many images the folder is goin to have
3. Any help would be much appreciated as ive been strugling with this for days*

CodePudding user response：

Try something like this:

Sub ReadFolder()
    Const ROW_START As Long = 3  'start row
    Const COL_START As Long = 3  'start column
    Const PER_ROW As Long = 4    'how many pics per row
    Dim File As Variant
    Dim Counter As Long
    Dim DirectoryList() As String
    Dim folder As Variant
    Dim shape As Excel.shape, ws As Worksheet, i As Long, c As Range
    
    'get folder or cancel
    Do
        folder = GetFolderPath("Select the source folder")
        If Len(folder) = 0 Then
            If MsgBox("Abort?", vbYesNo) = vbYes Then Exit Sub
        End If
    Loop While Len(folder) = 0

    'any files?
    File = Dir(folder & "*.png", vbNormal)
    If Len(File) = 0 Then
        MsgBox "No files in this folder"
        Exit Sub
    End If
    
    Set ws = Worksheets("Sheet1")
    For i = ws.Shapes.Count To 1 Step -1
        ws.Shapes(i).Delete
    Next i
    
    Set c = ws.Cells(ROW_START, COL_START) 'start cell for pics
    
    Do While Len(File) > 0
        
        Debug.Print "Inserting at: " & c.Address
        If c.Row = ROW_START Then c.ColumnWidth = 30 'only need to set once per row/column
        If c.Column = COL_START Then c.RowHeight = 100
        
        With ws.Pictures.Insert(folder & File)
            .Placement = xlMoveAndSize
            .Top = c.Top
            .Left = c.Left
            .ShapeRange.LockAspectRatio = msoFalse
            .Width = 170
            .Height = 100
        End With
        
        'where is the next picture going?
        If (c.Column - COL_START) >= PER_ROW - 1 Then         'already at max column?
            Set c = c.Offset(1).EntireRow.Cells(COL_START) 'first cell on next row
        Else
            Set c = c.Offset(0, 1)                 'move one cell over
        End If
        
        File = Dir()
    Loop
    
End Sub

'get a folder from the user - returns empty string if no selection
Function GetFolderPath(msg As String) As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = msg
        If .Show = -1 Then GetFolderPath = .SelectedItems.Item(1) & "\"
    End With
End Function