Macro enregistrer image

[devi16]

Bonjour;
J'ai un fichier avec deux colonne une avec du textes (A) et l'autre avec des images (B).
Je voudrais enregistrer les images dans un dossier en associent le texte comme nom de l'image.
Connaissez-vous une macro ?
voici le lien vers le dossier;
C:\Users\virginie\Pictures
Merci

 

[devi16]

Re : Macro enregistrer image

Voici un bout de code:

Sub enregistre_image()
Dim sh As Shape, img As Object
Dim nom As String
For Each sh In ActiveSheet.Shapes
If Left(sh.Name, 1) <> "B" Then
nom = Range(sh.TopLeftCell.Address).Offset(0, -1).Text
nom = "C:\Users\virginie\Pictures\" & nom & ".jpg"
sh.CopyPicture xlScreen, xlPicture
Set img = ActiveSheet.ChartObjects.Add(0, 0, sh.Width * 1.25, sh.Height * 1.25)
img.Chart.Paste
img.Chart.Export nom, "jpg"
img.Delete
End If
Next sh
End Sub

Mais il y a une erreur sur cette ligne :
nom = Range(sh.TopLeftCell.Address).Offset(0, -1).Text
Merci à ceux qui pourront m'aider