Reorder images into the suitable cells

[YasserKhalil]

Hello everyone
I have images in worksheet named `First`. The images names are `Image 1` & `Image 2` & `Image 3`and so on. What I need is to reorder the images to be in the suitable cells. I need that order cell A1 then C1 then A3 then C3 then A5 then C5 and so on. The images should be resized to fit each cell.

[HansV]

How about

Code: Select all

Sub MoveImages()
    Dim i As Long
    Dim shp As Shape
    Dim r As Long
    Dim c As Long
    i = 1
    r = 1
    c = 1
    Do
        Set shp = Nothing
        On Error Resume Next
        Set shp = ActiveSheet.Shapes("Image " & i)
        On Error GoTo 0
        If shp Is Nothing Then Exit Do
        With Cells(r, c)
            shp.Left = .Left
            shp.Top = .Top
            If shp.Width / shp.Height > .Width / .Height Then
                shp.Width = .Width
            Else
               shp.Height = .Height
            End If
        End With
        i = i + 1
        If i Mod 2 = 1 Then
            r = r + 2
        End If
        c = 4 - c
    Loop
End Sub

[YasserKhalil]

Thanks a lot but the code doesn't work for me as expected.

[HansV]

In what way doesn't it work?

[YasserKhalil]

The images are not placed correctly plus the resize is not correct. I have column width 39 as for column A & column C. And as for rows the row height for odd rows is 148. When trying to insert the image manually into any of my cells say A1 using Insert > Illustrations > Pictures, the picture is placed correctly and fit to the cell.

[HansV]

I have just retested the code, with the column widths and row heights that you mention. The images were placed correctly.

Could you attach a sample document with a small number of images? If it is too large, upload it to OneDrive, Google Drive, Dropbox or similar and post a link to it.

[YasserKhalil]

Here's an attachment of three images. Image 1 should be placed in A1, Image 2 in C1, Image 3 in A3

[YasserKhalil]

I have noticed the problem on my side. The code works well, but I have to run the code three times to be adjusted as expected.
Thank you very much.

[YasserKhalil]

Can I insert the images from a folder named [MyFiles]? The folder [MyFiles] has multiple subfolders, in some of them there are images that hold the name [01.jpg]. I need to loop through each subfolder and insert the images to the worksheet named [First] in the same order I mentioned earlier A1 - C1 - A3 - C3 - A5 - C5 and so on. And of course to resize the image to fit to the cell.

[snb]

Alternative

Code: Select all

Sub M_snb()
  For j = 1 To Sheet1.Shapes.Count
    Set it = Sheet1.Cells(2 * Int((j - 1) / 2) + 1, 1 + 2 * ((j - 1) Mod 2))
    
    With Sheet1.Shapes(j)
      .Top = it.Top
      .Left = it.Left
      .Width = it.Width
      .Height = it.Height
    End With
  Next
End Sub

[HansV]

Does this work?

Code: Select all

Sub ImportPictures()
    Const strParent = "C:\MyFiles\"
    Const strFile = "01.jpg"
    Dim wsh As Worksheet
    Dim fso As Object
    Dim fld As Object
    Dim sfl As Object
    Dim fil As Object
    Dim i As Long
    Dim r As Long
    Dim c As Long
    Application.ScreenUpdating = False
    Set wsh = ActiveSheet
    r = 1
    c = 1
    i = 1
    Set fso = CreateObject(Class:="Scripting.FileSystemObject")
    Set fld = fso.GetFolder(strParent)
    For Each sfl In fld.SubFolders
        Set fil = Nothing
        On Error Resume Next
        Set fil = fso.GetFile(sfl & "\" & strFile)
        On Error GoTo 0
        If Not fil Is Nothing Then
            With Cells(r, c)
                wsh.Shapes.AddPicture fil, False, True, .Left, .Top, .Width, .Height
            End With
            i = i + 1
            If i Mod 2 = 1 Then
                r = r + 2
            End If
            c = 4 - c
        End If
    Next sfl
    Application.ScreenUpdating = True
End Sub

[YasserKhalil]

Thanks a lot snb, but why I have to execute the code twice so as to adjust the images to the cells?

@Hans
Thank you very much for the awesome solution. It works very well.

[snb]

@Yas

You don't if you use application.screenupdating=true.