Tableau structuré en VBA modifier un enregistrement

Bonjour,

J'avais auparavant un tableur Excel tout a fait normal j'ai passé celui-ci en tableau structuré pour pouvoir travailler avec le nom des colonnes. J'adapte donc tout mon code à ce changement j'ai néanmoins un point sur lequel je but et qui représente une partie importante de mon code.

Je réalise un test successif sur toutes les cellules de ma colonne ID, je regarde si la valeur de l'ID est trouvée dans le nom d'un image d'un certain dossier si l'ID est trouvé dans une image alors le nom de l'image est copié et collé dans la cellule de la colonne "nom de l'image" et sur la même ligne de l'ID concerné. EN code normal ça donne ça maintenant je veux le passer avec un code correspondant à un tableau avec les noms de colonnes (lignes commentées à modifier).

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

ref = cells (lign, 1)
lign = 2 

Dim fso, SourceFolder, SubFolder, fichier, cheminETnom
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(Repertoire)

For each ref  
    For Each fichier In SourceFolder.Files
        If InStr(1, Repertoire & "\" & fichier.Name, ref, vbTextCompare) > 0 Then
            cheminETnom = LCase$(Repertoire & "\" & fichier.Name)
            Cells(lign, 5) = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\")' a modifier
            compteur = compteur + 1
            If compteur > 0 Then Exit Sub
        End If

        If fichier Like "*_" & ref & ".tif" Or fichier Like "*_" & ref & ".bmp" Or fichier Like ref & ".tif" Or fichier Like ref & ".bmp" Then
             Cells(lign, 5).Interior.Color = RGB(0, 255, 0)'a modifier
            compteur = compteur + 1
            If compteur > 0 Then Exit Sub
            End If
    Next fichier

    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
compteur =0
lign = lign +1
Next ref

End Sub

Bonjour,

il y a ici visiblement 2 problèmes

ref = cells (lign, 1)
lign = 2 

• lign est défini après son utilisation !
• et il y a un espace entre cells et les coordonnées de la cellule

pour le reste, mets un fichier avec un dossier comportant une image par exemple, ce sera plus facile !

du reste, ici on ne voit pas la problématique tableau structuré dont tu parles !

Man.403030 a écrit :

je veux le passer avec un code correspondant à un tableau avec les noms de colonnes (lignes commentées à modifier).

Essaie ceci

for each ref in Sheets("feuille").ListObjects("table").ListColumns("nom_colonne").Range

Bonjour,

Effectivement avec un exemple c'est toujours mieux. Par contre je ne peux mettre qu'une image et pas un dossier...

Quand à la déclaration oui c'est une erreur de ma part en voulant aller trop vite

Attention, j'ai mis jpg au lieu de tif pour moi tester. Et je n'ai fait qu'une première partie.

ref devient un range, et j'utilise offset pour mettre la valeur trouvée

Par ailleurs, exit sub était trop fort, il fallait mettre exit for

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 Range

For Each ref In Sheets("Feuil1").ListObjects(1).ListColumns("REF M3").Range

    flag = False
    For Each fichier In SourceFolder.Files
        If InStr(1, Repertoire & "\" & fichier.Name, ref.Value, vbTextCompare) > 0 Then
            cheminETnom = LCase$(Repertoire & "\" & fichier.Name)
            ref.Offset(0, 2).Value = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\"))) ' a modifier
            flag = True
            If flag Then Exit For
        End If
    Next fichier

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

Next

End Sub

Roh je ne sais plus ce que j'ai fait normalement s'il y a une image même en tif il n'y a rien dans la cellule, même pas les nom de l'image, la cellule elle est juste colorée.

C'était d'ailleurs pour ça le exit sub si l'image est trouvée pas besoin de reboucler pour vérifier l'extension. Bref, j'ai toujours le problème de position dans mon tableau

quelle position ? quel contenu ? je n'ai pas compris au travers du code ...

exemple avec images jpg

Justement mdr je ne sais pas quel code je dois utiliser, pour l'instant je travaille avec les coordonnées de mes cellules alors que j'aimerais travailler avec l'intersection s'une champ et d'un enregistrement ...

Et bien si vous reprenez le fichier que je vous ai joint dans un message précédent, que le nom de l'image trouvé grâce à la valeur de ref soit collé dans la colonne NOM DE L'IMAGE ASSOCIEE sur la même ligne que la ref qu'on a testé. Si une image est trouvée mais a une extension tif ou bmp alors aucun nom d'image n'est mis dans la cellule mais par contre la cellule est colorée.

Bon, j'ai répondu à ceci

je veux le passer avec un code correspondant à un tableau avec les noms de colonnes

en te montrant comme utiliser les tableaux structurés, cela doit te permettre de l'utiliser dans n'importe quel code. Mais je n'ai pas regardé l'aspect fonctionnel de to application. Explique alors ce que tu souhaites si je ne vais pas assez loin.

J'ai réussi à résoudre mon problème merci

 ref.Offset(0, 2).Value = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\"))) 

Cette ligne utilise une coordonnée de cellule si j'ajoute une colonne le nom de l'image ne sera plus mis au bon endroit

Range.("Tableau1[NOM DE L'IMAGE ASSOCIEE]")(ref) = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\")))

J'avais donc pensé utiliser une ligne ressemblant à ceci mais elle ne fonctionne pas savez-vous pourquoi ? Car dans les autres lignes elle fonctionne très bien...