Sauvegarde d'une image modifiée en VB [Résolu]

Messages postés
4
Date d'inscription
vendredi 30 avril 2010
Dernière intervention
14 avril 2011
- - Dernière réponse : Kedubon
Messages postés
4
Date d'inscription
vendredi 30 avril 2010
Dernière intervention
14 avril 2011
- 14 avril 2011 à 21:19
Bonjour à tous,

Ce post pour vous demander si vous connaissez un moyen en VBA pour sauvegarder une image.

J'ai chargé une image que j'ai retaillée pour mes besoins perso, mais je ne trouve pas le moyen de l'enregistrer automatiquement.

ActiveSheet.Pictures.Insert _( "D:\TrtPNG\MonImage.png").Select
Selection.ShapeRange.PictureFormat.CropLeft = 0
Selection.ShapeRange.PictureFormat.CropRight = 50.25

?????? 'que faut il faire pour la sauvegarder ?

Merci d'avance pour votre aide.

Kedubon
"les bugs c'est comme les murs, ça ne se pousse pas, ça se contourne)
Afficher la suite 

Votre réponse

4 réponses

Meilleure réponse
Messages postés
4
Date d'inscription
vendredi 30 avril 2010
Dernière intervention
14 avril 2011
3
Merci
Super Le Pivert, ça marche très bien

Je vais pouvoir continuer mes activités nocturnes :-)

A charge de revanche (si je peux te rendre service)

Bonne soirée à toi

Kedubon

"Etre en vacances c'est n'avoir rien à faire et avoir toute la journée pour le faire" :-)

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 105 internautes ce mois-ci

Commenter la réponse de Kedubon
Messages postés
5609
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
15 décembre 2018
0
Merci
Bonjour,
Tu peux te servir du presse-papier.
A mettre dans un module:

'http://excel.developpez.com/faq/?page=PressePapier
Option Explicit
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub Image_ClipBoard()
Dim x As Byte
Dim Sh As Shape
Dim monImage As String

'Compte le nombre d'objet initial dans la feuille
x = ActiveSheet.Shapes.Count

Application.ScreenUpdating = False
ActiveSheet.Range("A1").Select
'Colle le contenu du presse papier dans la feuille de calcul
ActiveSheet.Paste
'vérifie si le collage effectué correspond à une image
If x = ActiveSheet.Shapes.Count Then
    Application.ScreenUpdating = True
    MsgBox "Opération annulée"
    Exit Sub
    
    Else
    
    'Récupère la dernière forme de la feuille
    Set Sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    'Définit le nom et le lieu de stockage de l'image
    monImage = ActiveWorkbook.Path & "\monimage" & ".jpg"
     MsgBox "L'image est sauvegardée dans le dossier ClipBoard_VBA."
    'Colle l'image dans un graphique
    With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
        .Paste
        'Sauvegarde l'image du graphique au format jpg
        .Export monImage, "JPG"
    End With
    
    'Supprime le graphique et la forme.
    With ActiveSheet
        .ChartObjects(ActiveSheet.ChartObjects.Count).Delete
        .Shapes(ActiveSheet.Shapes.Count).Delete
    End With
    
    Application.ScreenUpdating = True
    
    
    '-------------------------------------------------------------
    'Option pour les utilisateurs de Windows XP :
    'visualisation de l'image créée, avec l'apercu images_telecopies Windows
    'testé avec Excel2002 et WinXP
    
    ShellExecute 0, "open", "rundll32.exe", _
        "C:\WINDOWS\System32\shimgvw.dll,ImageView_Fullscreen " & monImage, 0, 1
End If
End Sub


et pour appeler:

ActiveSheet.Pictures.Insert("D:\TrtPNG\MonImage.png").Select
Selection.ShapeRange.PictureFormat.CropLeft = 0
Selection.ShapeRange.PictureFormat.CropRight = 50.25
  Image_ClipBoard


J'ai essayé, cela fonctionne
@+ Le Pivert
Commenter la réponse de cs_Le Pivert
Messages postés
5609
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
15 décembre 2018
0
Merci
J'ai oublié de copier l'image
Pour appeler:

ActiveSheet.Pictures.Insert("D:\TrtPNG\MonImage.png").Select
Selection.ShapeRange.PictureFormat.CropLeft = 0
Selection.ShapeRange.PictureFormat.CropRight = 50.25
   Selection.Copy
  Image_ClipBoard
Commenter la réponse de cs_Le Pivert
Messages postés
4
Date d'inscription
vendredi 30 avril 2010
Dernière intervention
14 avril 2011
0
Merci
Merci beaucoup Le Pivert

Je vais tester ce code dès ce soir...

"La véritable noblesse consiste non pas à être supérieur à un autre homme, mais à ce qu'on était auparavant"

^^
Commenter la réponse de Kedubon

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.