Re : classement images
Bonjour, je relance ce post car la macro fourni par Efgé (que je remercie encore) me genere une erreur alors quelle fonctionnait bien , j'ai pourtant rien toucher je comprend pas 😕
voici la macro, j'ai mis en rouge la partie qui bloque
Private Sub CommandButton1_Click()
Dim Rep$, Fichier$
Dim D As Object, i&, j&, C As Variant, Tmp As Variant
Set D = CreateObject("Scripting.dictionary")
With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "OK"
.InitialFileName = ThisWorkbook.Path & " \ "
.Title = "Sélectionnez un dossier"
.Show
If .SelectedItems.Count > 0 Then
Rep = .SelectedItems(1): If Right(Rep, 1) <> "\" Then Rep = Rep & "\"
End If
End With
If Rep = "" Then Exit Sub
Fichier = Dir(Rep & "*.*")
Do While (Len(Fichier) > 0)
Tmp = Split(Fichier, "-")
D(Tmp(0)) = D(Tmp(0)) & Tmp(1) & ";"
Fichier = Dir() 'prochain fichier
Loop
ReDim TabReport(1 To D.Count, 1 To 10)
With Sheets("Images")
For Each C In D.Keys
Tmp = Split(D(C), ";")
For i = 2 To .Cells(Rows.Count, 3).End(3).Row
If CStr(.Cells(i, 3).Value) = CStr(C) Then
For j = LBound(Tmp) To UBound(Tmp) - 1
TabReport(i - 1, j + 1) = C & "-" & Tmp(j)
Next j
GoTo Suite
End If
Next i
Suite:
Next C
Flag = True
.Cells(2, 4).Resize(UBound(TabReport, 1), UBound(TabReport, 2)) = TabReport
Flag = False
End With
End Sub
