Récupèrer des images dans un classeur pour les placer dans un dossier.

[Claudy]

Bonjour,
j'ai un gros classeur avec beaucoup d'images, ce classeur devient obèse à cause des photos.
J'envisage de refaire ce classeur avec des liens vers un dossier où ces images seraient stockées.
Mais pour cela il me faudrait une macro qui irait rechercher toutes les images dans ce classeur obèse pour les placer dans ce nouveau dossier!
Votre avis, svp
Merci d'avance,
Claudy

 

[Claudy]

Re : Récupèrer des images dans un classeur pour les placer dans un dossier.

Re bonjour,
j'ai trouvé ceci sur Les images et shapes

Sub ExportImage()
répertoire = ThisWorkbook.Path
Set f = ActiveSheet
nomShape = "Pédalier"
Set img = f.Shapes(nomShape)
img.CopyPicture
f.ChartObjects.Add(0, 0, img.Width, img.Height).Chart.Paste
f.ChartObjects(1).Chart.Export Filename:=répertoire & "\" & "monimage.jpg", FilterName:="jpg"
f.ChartObjects(1).Delete
End Sub


Mais comment adapter à toutes les images de mon classeur?
Merci

 

[Claudy]

Re : Récupèrer des images dans un classeur pour les placer dans un dossier.

et voilà: j'ai trouvé:
Sub ExportImage()
répertoire = ThisWorkbook.Path & "\Photos"
Set f = ActiveSheet
i = 1
For Each s In f.Shapes

s.CopyPicture
f.ChartObjects.Add(0, 0, s.Width, s.Height).Chart.Paste
f.ChartObjects(1).Chart.Export Filename:=répertoire & "\" & i & ".jpg", FilterName:="jpg"
f.ChartObjects(1).Delete
i = i + 1

Next s
End Sub

Merci Claudy....