Consulting

Results 1 to 2 of 2

Thread: How to sort files before inserting to worksheet

  1. #1

    How to sort files before inserting to worksheet

    I am using a macro to insert picture from subfolders to worksheet.Picture name is in the order 0,10,30,60,90,120,150,180,210,240,270,300,330 etc....
    Now its inserting picture in the order

    0 10
    120 150
    180 210
    240 270
    300 30
    330 60
    90

    But The output i required is

    0 10
    30 60
    90 120
    150 180
    210 240
    270 300
    330

    Pls help..

    Code i am using is....

    Option Explicit

    Private fso As Object
    Private fsoRoot As Object
    Private fsoFolder As Object
    Private fsoFile As Object

    Const strRootFolder As String = "C:\Pictures"

    '########################################################################## ############################################# #####
    '########################################################################## ############################################# #####
    Public Sub MainLine()

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fsoRoot = fso.GetFolder(strRootFolder)

    Application.ScreenUpdating = False

    Call libProcessFolder(fsoRoot)

    Application.ScreenUpdating = False

    End Sub

    '########################################################################## ############################################# #####
    '########################################################################## ############################################# #####

    Private Sub libProcessFolder(ByRef prmFolder As Object)
    On Error Resume Next

    Dim wbkPictures As Excel.Workbook
    Dim xlsPictures As Excel.Worksheet
    Dim lngRowNumber As Long
    Dim strColumnName As String

    lngRowNumber = -8
    strColumnName = "A"

    '#
    '# first process all objects with the folder received and when valid jpg files are found, create a new
    '# workbook instance and start inserting pictures on the first worksheet
    '#
    For Each fsoFile In prmFolder.Files
    If fsoFile.Name Like "*.jpg" Then

    '# create a workbook object if not yet opened
    If lngRowNumber < 0 Then
    Set wbkPictures = Application.Workbooks.Add
    Set xlsPictures = wbkPictures.Worksheets(1)
    lngRowNumber = lngRowNumber + 10
    End If

    '# insert the picture
    With xlsPictures.Pictures.Insert(fsoFile.Path)
    .Left = xlsPictures.Cells(lngRowNumber, strColumnName).Left
    .Top = xlsPictures.Cells(lngRowNumber, strColumnName).Top
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = 125#
    .ShapeRange.Width = 150#
    .ShapeRange.Rotation = 0#
    End With

    '# insert the picture name one row above the picture
    xlsPictures.Cells(lngRowNumber - 1, strColumnName).Value = Split(fsoFile.Name, ".")(0)

    '# set the location for the next picture
    If strColumnName = "A" Then
    strColumnName = "F"
    Else
    strColumnName = "A"
    lngRowNumber = lngRowNumber + 10
    End If

    End If
    Next fsoFile

    '#
    '# if pictures were found, the workbook created is to be saved using the name of the folder
    '#
    If lngRowNumber > 0 Then
    wbkPictures.SaveAs strRootFolder & "\" & prmFolder.Name & ".xls"
    wbkPictures.Close
    End If

    '#
    '# repeat the process for any subfolders found
    '#
    For Each fsoFolder In prmFolder.SubFolders
    Call libProcessFolder(fsoFolder)
    Next fsoFolder

    End Sub

  2. #2
    Put the file names in an array or sheet column, sort them (VBA Sort function or write your own or copy one from the web), then insert based on the sorted image name.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •