Discussion :

[re]

Bonjour,
Je ne sais pas plus ou j'ai récupéré ce bout de code

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)

Je voudrai remplacer 'Set objfolder = objShell.Namespace("C:\Users\Utilisateur\Pictures\test"), pour aller chercher l'image jpg (test_img.jpg par exemple) qui se trouve dans le répertoire courant, là ou ce trouve le fichier xlsm, mais mon niveau VBA ne me le permet pas encore ;-)
Pour que le fichier puisse être utilisé sur n'importe quel PC, je ne voudrai pas que le chemin soit inscrit dans le code.
Pouvez-vous m'aider ?
Merci
bon WE

[Theze]

Bonjour,

Une piste :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub Test()
 
    Dim Chemin As String
 
    'construit le chemin
    Chemin = ThisWorkbook.Path & "\" & "test_img.jpg"
 
    'contrôle la présence du fichier dans le dossier
    If Dir(Chemin) <> "" Then MsgBox "Le fichier se trouve bien dans le dossier du calsseur"
 
End Sub

[re]

Merci pour ta rapide réponse mais je l'insère ou et à la place de quoi ?

Voici la macro complete

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Code_champs_proprietes()
Sheets("Code").Select
[B2:C310].ClearContents
 
Dim det_Headers(300)
 
Set objShell = CreateObject("Shell.Application")
Workbooks(1).Sheets(1).Activate
 Set objfolder = objShell.Namespace("C:\Users\Utilisateur\Pictures\test")        ' idéalement il faudrait aller chercher l'image jpg dans le repertoire ou est situé le fichier xlsm 
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

[Theze]

Il te suffit de remplacer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Set objfolder = objShell.Namespace("C:\Users\Utilisateur\Pictures\test")

par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Set objfolder = objShell.Namespace(ThisWorkbook.Path & "\")

[re]

Merci,
Effectivement ça fonctionne mais ça liste tous les fichiers qu'il y a dans le repertoire, je ne voudrai lister qu'une seule photo ex: test_img.jpg

Cela me permet de récupérer tous les codes de champs des propriétés ils sont différents suivant l'OS ou les offices utilisés (?)
Jusqu'à présent je pouvais le gérer mais je ne sais pas pourquoi ces codes changent

[Theze]

Comme tu demandais d'utiliser le code que tu avais posté, j'en avais déduit que c'était ce que tu souhaitais comme résultat !
Pour insérer une image dans une feuille de calcul :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub Test()
 
    Dim Chemin As String
    Dim NomImg As String
 
    'nom de l'image
    NomImg = "test_img.jpg"
 
    'construit le chemin
    Chemin = ThisWorkbook.Path & "\" & NomImg
 
    'contrôle la présence du fichier dans le dossier
    If Dir(Chemin) <> "" Then ActiveSheet.Pictures.Insert Chemin
 
End Sub