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

Y compris Power BI, Power Query et toute autre question en lien avec Excel
c
canthagar
Nouveau venu
Nouveau venu
Messages : 4
Inscrit le : 2 mars 2015
Version d'Excel : 2013 en

Message par canthagar » 3 mars 2015, 09:43

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
c
canthagar
Nouveau venu
Nouveau venu
Messages : 4
Inscrit le : 2 mars 2015
Version d'Excel : 2013 en

Message par canthagar » 4 mars 2015, 16:50

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
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message