Changer offset avec le nom de colonne

Bonjour,

J'utilise le code suivant pour associer une image à chaque référence qui sont toutes dans une même colonne de nom REF , ce qui revient à dans mon tableur à coller le nom de l'image sur la même ligne que la référence à laquelle elle correspond mais dans une colonne différente.

Cette procédure assure ce que j'ai précisé avant, j'aimerais changer l'utilisation du ref.offset et utiliser le nom de la colonne car il se peut que j'ai à changer l'agencement de mon document, dont l'ordre de mes colonnes il faudrait alors que je change mon code à chaque fois. Y a t'il une fonction qui pourrait remplacer ref.offset ? J'ai essayé avec la ligne en commentaire juste en dessous de celle à changer mais elle n'est pas fonctionnelle.

Ensuite j'ai un deuxième problème, dans le premier for each il prend en compte la première ligne de mon tableau (nom de la colonne) dont je n'ai pas besoin peut-on l'exclure du for each et si oui comment ?

Merci d'avance pour votre aide !

Sub ListeFichiers(Repertoire As String) 'procédure permettant de trouver le nom de l'image dans le répertoire ou sous répertoires, la cellule est colorée si l'image trouvée n'a pas la bonne extension

Dim fso, SourceFolder, SubFolder, fichier, cheminETnom
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(Repertoire)
Dim ref As Variant
'Dim num As Long
'num = 2

For Each ref In Sheets("FINITIONS").ListObjects("Tableau1").ListColumns("REF M3").Range
    For Each fichier In SourceFolder.Files
        If InStr(1, Repertoire & "\" & fichier.Name, ref, vbTextCompare) > 0 Then
            cheminETnom = LCase$(Repertoire & "\" & fichier.Name)
            ref.Offset(0, 7).Value = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\")))
            'Range("Tableau1[NOM DE L IMAGE ASSOCIEE]")(num) = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\")))
            compteur = compteur + 1
            If compteur > 0 Then Exit For
        End If

        If fichier Like "*_" & ref & ".tif" Or fichier Like "*_" & ref & ".bmp" Or fichier Like ref & ".tif" Or fichier Like ref & ".bmp" Then
            ref.Offset(0, 2).Interior.Color = RGB(0, 255, 0)
            'Range("Tableau1[NOM DE L IMAGE ASSOCIEE]")(num).Interior.Color = RGB(0, 255, 0)
            compteur = compteur + 1
            'num = num + 1
            If compteur > 0 Then Exit Sub
            End If
    Next fichier

    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder

Select Case compteur
        Case 0: ref.Offset(0, 7).Interior.Color = RGB(255, 0, 0)
        Case 1: compteur = 0
End Select
Next ref

End Sub

Bonjour Man,

Je n'ai pas regardé attentivement le code, mais ainsi, ça devrait être mieux.

Si tu avais des noms de colonnes plus courts (IMAGE, M3), ce serait encore mieux.

Sub ListeFichiers(Repertoire As String) 'procédure permettant de trouver le nom de l'image dans le répertoire ou sous répertoires, la cellule est colorée si l'image trouvée n'a pas la bonne extension

Dim fso, SourceFolder, SubFolder, fichier, cheminETnom
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(Repertoire)
Dim ref As Variant
'Dim num As Long
'num = 2

For Each ref In Sheets("FINITIONS").Range("Tableau1[REF M3]")
    num = num + 1
    For Each fichier In SourceFolder.Files
        If InStr(1, Repertoire & "\" & fichier.Name, ref, vbTextCompare) > 0 Then
            cheminETnom = LCase$(Repertoire & "\" & fichier.Name)
            Range("Tableau1[NOM DE L IMAGE ASSOCIEE]")(num) = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\")))
            compteur = compteur + 1
            If compteur > 0 Then Exit For
        End If

        If fichier Like "*_" & ref & ".tif" Or fichier Like "*_" & ref & ".bmp" Or fichier Like ref & ".tif" Or fichier Like ref & ".bmp" Then
            Range("Tableau1[NOM DE L IMAGE ASSOCIEE]")(num).Interior.Color = RGB(0, 255, 0)
            compteur = compteur + 1
            If compteur > 0 Then Exit Sub
        End If
    Next fichier

    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder

    Select Case compteur
        Case 0: ref.Offset(0, 7).Interior.Color = RGB(255, 0, 0)
        Case 1: compteur = 0
    End Select

Next ref

End Sub

Cdlt,

Bonjour,

Il suffit de modifier cette instruction :

For Each ref In Range("Tableau1").ListObject.ListColumns("REF M3").DatabodyRange

Merci 3GB ça fonctionne très bien

Merci thev de ta proposition