Enregistrer une image depuis excel dans un fichier Résolu/Fermé

Question

Bonjour à tous, 

J'essaie de créer une macro afin de faire l'action suivante : 

Repérer si une cellule dans une colonne fixe contient une photo/image
Si c'est le cas, je souhaite enregistrer la photo/image de cette cellule en jpg dans un fichier au chemin prédéfini et unique. Le nom de cette image doit être celui de la valeur de la cellule correspondante dans laquelle se trouve l'image. 
Si la cellule ne contient pas d'image, alors je passe à la suivante. 

J'ai joint un exemple pour que ce soit plus clair : 
Dans la cellule A2, j'ai bien une image, je veux donc que celle-ci soit enregistrée dans mon fichier (chemin défini) sous le nom 1. 
Ma macro passe les autres cellules jusqu'à ce qu'elle arrive en A7, elle enregistre alors l'image en A7 sous le nom 4667 en jpg.

Voilà j'espère que c'est clair, je débute en VBA et je bloque dès qu'il s'agit de travailler avec des images.

Merci d'avance pour votre aide !

Bonne journée,

rEVOLV3r · Answer

Bonjour,
Voilà la macro toute fraiche.
Modifiez là à votre guise.

Public Sub Export_images()
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim path As String
    Dim chtObj As ChartObject
    
    Set wb = ThisWorkbook
    Set sh = wb.Sheets(1)
    path = wb.path & "\Images\"
    
    
    '/////Sélection des images en colonne 1
    For Each shp In sh.Shapes
        If Not Intersect(shp.TopLeftCell, sh.Columns(1)) Is Nothing Then
            'Export des images
            Set chtObj = sh.ChartObjects.Add(300, 300, 400, 250)
            chtObj.Name = "TemporaryPictureChart"
            chtObj.Width = sh.Shapes(shp.Name).Width
            chtObj.Height = sh.Shapes(shp.Name).Height
            chtObj.Border.LineStyle = 0
            sh.Shapes.Range(Array(shp.Name)).Select
            Selection.Copy
            sh.ChartObjects("TemporaryPictureChart").Activate
            ActiveChart.Paste
            ActiveChart.Export Filename:=path & shp.TopLeftCell.Value & ".jpg", FilterName:="jpg"
            chtObj.Delete
        End If
    Next shp
End Sub

Bonne journée