Bonjour,
Je ne sais pas ou j'ai récupéré cette macro, elle fonction très bien mais il faudrait faire une petite modification que mon niveau VBA ne me permet pas.
Il faudrait extraire les propriétés d'une seule photo qui se trouve dans le repertoire du fichier xlsm.
actuellement cette macro liste tous les fichiers du repertoire.
Il faudrait peut être modifier cette ligne
Set objfolder = objShell.Namespace("C:\Users\Utilisateur\Pictures\test")
pour aller chercher la photo test.jpg uniquement qui est dans le même repertoire que le fichier xlsm
Merci de votre aide
Je ne sais pas ou j'ai récupéré cette macro, elle fonction très bien mais il faudrait faire une petite modification que mon niveau VBA ne me permet pas.
Il faudrait extraire les propriétés d'une seule photo qui se trouve dans le repertoire du fichier xlsm.
actuellement cette macro liste tous les fichiers du repertoire.
Il faudrait peut être modifier cette ligne
Set objfolder = objShell.Namespace("C:\Users\Utilisateur\Pictures\test")
pour aller chercher la photo test.jpg uniquement qui est dans le même repertoire que le fichier xlsm
Code:
Sub Code_champs_proprietes()
Sheets("Code").Select
[B2:C310].ClearContents
Dim det_Headers(300)
Set objShell = CreateObject("Shell.Application")
Set objfolder = objShell.Namespace("C:\Users\Utilisateur\Pictures\test")
Workbooks(1).Sheets(1).Activate
For i = 0 To 300
det_Headers(i) = objfolder.GetDetailsOf(objfolder.Items, i - 1)
ActiveSheet.Cells(i + 1, 2) = det_Headers(i)
Next
Workbooks(1).Sheets(1).Activate
j = 3 'colonne
For Each strFilename In objfolder.Items
For i = 0 To 300
Sheets(1).Cells(i + 2, j).Value = objfolder.GetDetailsOf(strFilename, i)
Next
j = j + 1
Next
End Sub
Merci de votre aide