Autres Petit defi du jour

        Do While fichiers <> ""
            Select Case Split(LCase(fichiers), ".")(UBound(Split(LCase(fichiers), "."))) 'Split(LCase(fichiers), ".")(1)
                Case "jpg", "jpeg", "png", "gif", "bmp", "tiff"
                    a = a + 1: ReDim Preserve tbl(1 To a): tbl(a) = DosSier & fichiers
            End Select
            fichiers = Dir
        Loop

Sub GoPatchwork2()
    Dim a&, B&, C&, D&, E&, F&, G&
    '---------------------------------------
    clearPatwork2
    '-----------------------------------------
    a = [B6] 'hauteur de l'image donc hauteur des lignes
    B = [B5].Value 'Nombre d'images par ligne
    C = Int(Cells(2, 1).Top) 'Top de depart
    D = [D1].Left 'left de depart
    E = [B7] 'combler les trous avec des doublon(0 pour non/1 pour oui)
    F = [B8] 'melanger les images
    G = [B9] 'terminer les bandes avec des images tronquées
    CreatePatchwork2 a, B, C, D, E, F, G
End Sub



Sub CreatePatchwork2( _
                     Optional hauteurmax& = 100, _
                     Optional NbPictureByRow& = 4, _
                     Optional Topdepart& = 0, _
                     Optional LeftStart = 0, _
                     Optional FillGapsDuplicates = 0, _
                     Optional UnOrderedPicture& = 0, _
                     Optional TerminalCropImage& = 0)
    Application.ScreenUpdating = False
    Dim p As Range, fichiers, topx&, count&, fin#, TrOu, LeftX&, tbl(), a&, q&, temp, W#, Timages(), x&
    Dim DosSier, img
    Dim dicoRight As Object, it, elem, dicoDoublons As Object
    Set dicoRight = CreateObject("scripting.dictionary")
    Set dicoDoublons = CreateObject("scripting.dictionary")
    topx = Topdepart
    LeftX = LeftStart
    'dialog folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "CHOISISSEZ LE DOSSIER D IMAGES"
        If .Show <> -1 Then Exit Sub
        DosSier = .SelectedItems(1) & "\"
    End With
 
    'dir fichieret stakage des liens fichier dans une variable tableau
    fichiers = Dir(DosSier & "\*.*")
    If fichiers <> "" Then
        Do While fichiers <> ""
            Select Case Split(LCase(fichiers), ".")(UBound(Split(LCase(fichiers), "."))) 'Split(LCase(fichiers), ".")(1)
                Case "jpg", "jpeg", "png", "gif", "bmp", "tiff"
                    a = a + 1: ReDim Preserve tbl(1 To a): tbl(a) = DosSier & fichiers
            End Select
            fichiers = Dir
        Loop

      Etc...... suite dans le code a @patricktoulon