Sauver image dans un fichier définit et afficher le path

Bonjour,

Je cherche créer une macro qui puisse supprimer une image dans une cellule si il y en a une, importer une image dans cette cellule, sauver cette image dans un fichier définit et afficher dans une autre cellule le Path pour l’image sauvée.

Si quelqu’un a un code que je puisse utiliser ce serait super !

Merci encore !

Pour le moment mon code ressemble ca :

Private Sub CommandButton1_Click()
    Dim Emplacement As Range
    Dim Img As Object
    Dim ShapeObj As Shape

    'Boucle pour supprimer l'ancienne image
    For Each ShapeObj In ActiveSheet.Shapes
        If ShapeObj.name = "*" Then ActiveSheet.Shapes("*").Delete
    Next ShapeObj

    If Application.Dialogs(xlDialogInsertPicture).Show Then
        'Définit l'emplacement de l'image
       Set Emplacement = Cells(2, 9)
       Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
        With Img.ShapeRange
            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
            .name = ListBox1 + "image"
            .LockAspectRatio = msoTrue
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With

    Else
        MsgBox "Insertion d'image interrompue."
    End If
End Sub

voila ce que j'ai fait:

vous en pensez quoi?

il ne me reste plus qu'a obliger à séléctionner des images mais autrement ca fonctionne

Private Sub CommandButton1_Click()
  On Error GoTo ErrorHandler
  Dim NomPicture As String
    Dim Picture1 As Variant

    Picture1 = Application.GetOpenFilename( _
        FileFilter:="all,*.*", _
        Title:="Sélectionnez une image à sauvegarder")

    NomPicture = Right(Picture1, Len(Picture1) - InStrRev(Picture1, "\"))  'trouve le nom du fichier
    FileCopy Picture1, "C:\blabla" & NomPicture  'Copie du fichier dans l'autre emplacement
    ActiveCell.Offset(0, 8) = "C:\blabla" & NomPicture

     ActiveSheet.Pictures.Insert("C:\blabla" & NomPicture).Select

    With Selection.ShapeRange
        .Left = ActiveCell.Offset(0, 8).Left
        .Top = ActiveCell.Offset(0, 8).Top
    End With
form1.Image1.Picture = LoadPicture("C:\blabla\" & NomPicture)

Exit Sub

ErrorHandler:

MsgBox "L'image téléchargée n'est pas valide veuillez la changer"

End Sub
Rechercher des sujets similaires à "sauver image fichier definit afficher path"