Sauvegarder une image en jpg

[MJ13]

Bonjour à tous

J'ai une image sur une feuille Excel que je voudrai sauvegarder en jpg.

Auriez vous un code simple en VBA?

Merci d'avance.

Ce serait un peu du style de ce post (je remercie BOCARAMEL au passage)

https://www.excel-downloads.com/threads/recuperation-image-graphe-excel.124400/

mais pas pour les graphiques, mais pour les images.

 

[tototiti2008]

Re : Sauvegarder une image en jpg

Bonjour Michel,

une solution consiste à copier ton image dans un graphique, à mettre le graphique à la taille de l'image et à l'enregistrer en jpg comme dans le code du lien... mais ce n'est pas trés satisfaisant. L'image conserve en général un bord tout autour (le cadre du graphique).
Sinon peut-être en passant par Powerpoint, car Powerpoint permet d'enregistrer une image si on fait un clic droit dessus... (ce ne sont que des pistes)

 

[MJ13]

Re : Sauvegarder une image en jpg

Bonjour Tototiti

Merci pour ces astuces. mais j'aimerai le faire directement c'est pour scinder facilement des images et leurs donner des noms bien définis.

Sinon j'ai trouvé cette Procédure de Michel Pierron qui enregistre l'image dans le presse papier puis le sauve en .WMF mais j'aimerai mieux la mettre en JPG et la je n'ai pas trouvé.

Option Explicit
Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function _
GetClipboardData& Lib "user32" (ByVal wFormat&)
Private Declare Function CopyEnhMetaFileA& _
Lib "gdi32" (ByVal hemfSrc&, ByVal lpszFile$)
Private Declare Function _
DeleteEnhMetaFile& Lib "gdi32.dll" (ByVal hemf&)
 
Sub [B][COLOR=#ff0000]SaveShapeAsMetafile[/COLOR][/B]()
'Michel Pierron
If ThisWorkbook.Sheets(1).Shapes.Count = 0 Then Exit Sub
On Error GoTo SaveWmf_Error
Dim Img As Shape, hCopy&, fName$
For Each Img In ThisWorkbook.Sheets(1).Shapes
Img.Copy: OpenClipboard 0&
hCopy = GetClipboardData(14)
If hCopy Then
fName = ThisWorkbook.Path & "\" & Img.Name & ".wmf"
DeleteEnhMetaFile CopyEnhMetaFileA(hCopy, fName)
EmptyClipboard
End If
CloseClipboard
Next Img
Exit Sub
SaveWmf_Error:
MsgBox "Error " & Err.Number & vbLf & Err.Description, 48
End Sub

 

[Guest]

Re : Sauvegarder une image en jpg

bonjour Michel, tototiti,

Personnellement j'utilise la macro suivante,

Peut-être à adapter à ton projet pour en faire une boucle.

Sub EnregistrerImage()
'fonctionne sous 2002 et 2007
    If TypeName(Selection) <> "Picture" Then
        MsgBox "Selectionnez une image puis recommencez", vbInformation, "Enregistrer une image"
        Exit Sub
    End If
    Selection.CopyPicture
    With Selection.Parent
        With .ChartObjects.Add(Selection.Left, Selection.Top, Selection.Width, Selection.Height)
            .Height = Selection.Height
            .Width = Selection.Width
            With .Chart
                .Paste
                .Export "D:\LUI\Developement\VB_VBA\Excel\Forum\Imagetmpforum.jpg", "JPEG", True
            End With
            .Delete
        End With
    End With
End Sub

A+

 

[Hulk]

Re : Sauvegarder une image en jpg

Hello,

Voici ce que j'ai trouvé ici, bravo à l'auteur !

    Dim nb As Byte

    Application.ScreenUpdating = False

    For Each Pict In Worksheets("Feuil1").Pictures
        Pict.CopyPicture
    With ActiveSheet.ChartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart
        .Paste
        .Export ThisWorkbook.Path & "\" & Pict.Name & ".jpg", "JPG"
    End With
        nb = ActiveSheet.ChartObjects.Count
        ActiveSheet.ChartObjects(nb).Delete
    Next

Attention, si tu places ce code sur un bouton sur la feuille, il fait aussi une image du bouton !

Cdt, Hulk.

 

[MJ13]

Re : Sauvegarder une image en jpg

Bonjour Hasco, Hulk

Merci pour vos codes qui devraient bien m'aider.

Hulk, je pense que Michel doit être l'ancien nom de MichelXLD sur l'ancien forum (c'est son style que l'on peut reconnaître).

 

[MJ13]

Re : Sauvegarder une image en jpg

Re

Bon Voici le code qui m'a servi et qui va me servir.

Merci à tous

Sub lance_ImgJPG_MichelXLD()
 'MichelXLD adaptation MJ
Dim nb As Byte
'Stop
ActiveWindow.Zoom = 40
    Application.ScreenUpdating = False
monSauv = Application.DefaultFilePath & "\" & ThisWorkbook.ActiveSheet.Range("P2") & ".jpg"
    For Each Pict In Worksheets(ActiveSheet.Name).Pictures
        Pict.CopyPicture
    With ActiveSheet.ChartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart
        .Paste
        .Export monSauv, "JPG"
    End With
        nb = ActiveSheet.ChartObjects.Count
        ActiveSheet.ChartObjects(nb).Delete
    Next
ActiveWindow.Zoom = 75
 End Sub

 

[joe kent]

Re : Sauvegarder une image en jpg

s'il vous plait, j'aimerais savoir comment sauvegarder en fichier jpg une image issue d'un userform

 

[Staple1600]

Re : Sauvegarder une image en jpg

Bonsoir à tous

joe kent: [highlight]Bienvenue sur le forum[/code]

s'il vous plait, j'aimerais savoir

S'il vous plait dites à la maman de joe kent qu'il/elle a oublié les bonnes manières que je suis sûr qu'elle n'a pas manqué de lui a apprise quand il/elle était petit nenfant(e) ...

Joe kent :"Pourquoi tu me parles de ma maman !!!"
Staple : "Parce que !"

extrait de la charte forum

2 – Lorsqu’on rentre sur un fil, comme dans la vie de tous les jours, on est poli en disant « Bonjour ».

NB: l'usage est de créer sa propre discussion pour poser sa question.
Mais avant de la poser, ne pas oublier encore une fois la charte du forum.
[ Lien supprimé le point 1) de la section Demandeur]

 

[joe kent]

Re : Sauvegarder une image en jpg

Bonsoir à tous
je m'excuse pour mon manque de politesse
s'il vous plait, j'aimerais savoir comment sauvegarder en fichier jpg une image issue d'un userform