Reorder images into the suitable cells

YasserKhalil
PlatinumLounger
Posts: 4909
Joined: 31 Aug 2016, 09:02

Reorder images into the suitable cells

Post by 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.

User avatar
HansV
Administrator
Posts: 78071
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Reorder images into the suitable cells

Post by 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
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4909
Joined: 31 Aug 2016, 09:02

Re: Reorder images into the suitable cells

Post by YasserKhalil »

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

User avatar
HansV
Administrator
Posts: 78071
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Reorder images into the suitable cells

Post by HansV »

In what way doesn't it work?
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4909
Joined: 31 Aug 2016, 09:02

Re: Reorder images into the suitable cells

Post by 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.

User avatar
HansV
Administrator
Posts: 78071
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Reorder images into the suitable cells

Post by 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.
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4909
Joined: 31 Aug 2016, 09:02

Re: Reorder images into the suitable cells

Post by YasserKhalil »

Here's an attachment of three images. Image 1 should be placed in A1, Image 2 in C1, Image 3 in A3
You do not have the required permissions to view the files attached to this post.

YasserKhalil
PlatinumLounger
Posts: 4909
Joined: 31 Aug 2016, 09:02

Re: Reorder images into the suitable cells

Post by 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
PlatinumLounger
Posts: 4909
Joined: 31 Aug 2016, 09:02

Re: Reorder images into the suitable cells

Post by 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
4StarLounger
Posts: 542
Joined: 14 Nov 2012, 16:06

Re: Reorder images into the suitable cells

Post by 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

User avatar
HansV
Administrator
Posts: 78071
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Reorder images into the suitable cells

Post by 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
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4909
Joined: 31 Aug 2016, 09:02

Re: Reorder images into the suitable cells

Post by 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
4StarLounger
Posts: 542
Joined: 14 Nov 2012, 16:06

Re: Reorder images into the suitable cells

Post by snb »

@Yas

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