Exporter une image excel dans un dossier

Résolu/Fermé

BETBOOM Messages postés 7 Date d'inscription mardi 10 septembre 2019 Statut Membre Dernière intervention 3 juin 2020 - 2 juin 2020 à 19:48
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 - 3 juin 2020 à 17:11

Bonjour tous le monde,
dans un document excel j'utilise une macro assignée à un bouton de commande pour prendre une photo d'une partie de ma feuille et la coller un peu plus loin sur cette même feuille. Puis je copie l'image ainsi créée, la colle dans Paint, puis l'enregistre dans un dossier de mon ordinateur.

cependant, j'aimerai pouvoir réaliser cela sans devoir passer par l'étape Paint.

Du coup j'aimerai créer un deuxième bouton de commande qui exportera cette image dans un dossier bien défini avec un nom bien défini.
Ou encore mieux, avoir une macro qui pourra créer une image et l'exporter en une seule action.

ci dessous ma macro actuelle qui crée l'image:

Private Sub bouton1_Click()

Dim sh As Shape

Range("V62").Select
Worksheets("SB fold").Range("A62:P75").CopyPicture
Worksheets("SB fold").Paste

End Sub

Merci de votre aides

A voir également:

Exporter excel en jpg
Liste déroulante excel - Guide
Mise en forme conditionnelle excel - Guide
Si et excel - Guide
Aller à la ligne excel - Guide
Chrome exporter favoris - Guide

6 réponses

Réponse 1 / 6

Utilisateur anonyme
2 juin 2020 à 20:49

Bonjour
Allez voir cela https://software-solutions-online.com/excel-vba-save-table-as-jpeg/
A+

Réponse 2 / 6

BETBOOM Messages postés 7 Date d'inscription mardi 10 septembre 2019 Statut Membre Dernière intervention 3 juin 2020
2 juin 2020 à 22:52

merci mais je n'ai pas réussi, ça m'écrit erreur débogage etc.

Réponse 3 / 6

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
Modifié le 3 juin 2020 à 09:30

Bonjour

Pour éviter de te prendre la t^te avec des macros, pourquoi ne pas utiliser un logiciel gratuit de capture d'écran tel que faststone capture ; tu pourras enregistrer directement la capture dans un dossier (en plus tu peux l'annoter avec l'outil dessin)
https://www.clubic.com/telecharger-fiche18509-faststone-capture.html

Un exemple de capture pour une explication récente sur CCM-bureautique:

Cette capture est un exrmple qui n'a rien à voir avec ton souci...

BETBOOM Messages postés 7 Date d'inscription mardi 10 septembre 2019 Statut Membre Dernière intervention 3 juin 2020
3 juin 2020 à 11:32

Bonjour. Car en fait je vais avoir 20 feuilles avec chacune 20 images a exporter. Et je serai susceptible de modifier les grilles puis de les réexporter. Donc trop long de capturer par logiciel a chaque modification. Pour le moment je copie colle l'image sur word, je fais clique droit, et enregistrer en tant qu'image sous. mais juste cliquer sur un bouton pour faire tout cela serait top.

Réponse 4 / 6

cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
3 juin 2020 à 08:51

bonjour,

comme ceci:

Option Explicit
Sub Example1()
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
'copy the range as an image
Call Worksheets("Feuil1").Range("A1:E12").CopyPicture(xlScreen, xlPicture) 'adapter la feuille et la plage de cellule
'remove all previous shapes in sheet2
intCount = Worksheets("Feuil2").Shapes.Count 'adapter la feuille
For i = 1 To intCount
Worksheets("Feuil2").Shapes.Item(1).Delete
Next i
'create an empty chart in sheet2
Worksheets("Feuil2").Shapes.AddChart
'activate sheet2
Worksheets("Feuil2").Activate
'select the shape in sheet2
Worksheets("Feuil2").Shapes.Item(1).Select
Set objChart = ActiveChart
Worksheets("Feuil2").Shapes.Item(1).Width = Range("A1:E12").Width 'adapter la plage de cellule
Worksheets("Feuil2").Shapes.Item(1).Height = Range("A1:E12").Height 'adapter la plage de cellule
'paste the range into the chart
objChart.Paste
'save the chart as a JPEG
objChart.Export ("C:\Users\LePivert\Documents\Example.Jpeg") 'adapter le chemin
End Sub

voilà

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
3 juin 2020 à 09:28

il s'agit d'envoyer une photo ou image dans un dossier et non de l'envoyer sur une feuille...

cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729 > michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023
3 juin 2020 à 11:25

Voilà la demande:

dans un document excel j'utilise une macro assignée à un bouton de commande pour prendre une photo d'une partie de ma feuille et la coller un peu plus loin sur cette même feuille. Puis je copie l'image ainsi créée, la colle dans Paint, puis l'enregistre dans un dossier de mon ordinateur.

c'est exactement ce que fait la macro!

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310 > cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024
3 juin 2020 à 11:32

Pourquoi faire simple quand on peut faire compliqué !

je ne suis pas le demandeur. Je me suis contenté de mettre la macro fournie par le lien opérationnelle!

BETBOOM Messages postés 7 Date d'inscription mardi 10 septembre 2019 Statut Membre Dernière intervention 3 juin 2020
3 juin 2020 à 11:44

Merci, ta macro fonctionne bien, par contre elle se place a un endroit en feuille 2 que je n'arrive pas a modifier. ci joint mon fichier test. j'aimerai que l'image temporaire se place dans le cadre juste à droite, sur la même feuille nommé "BTN" sur la plage (U4:AG17):

ici ta macro modifié avec mes ranges:

Sub Example1()
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
'copy the range as an image
Call Worksheets("BTN").Range("A4:M17").CopyPicture(xlScreen, xlPicture) 'adapter la feuille et la plage de cellule
'remove all previous shapes in sheet2
intCount = Worksheets("SB").Shapes.Count 'adapter la feuille
For i = 1 To intCount
Worksheets("SB").Shapes.Item(1).Delete
Next i
'create an empty chart in sheet2
Worksheets("SB").Shapes.AddChart
'activate sheet2
Worksheets("SB").Activate
'select the shape in sheet2
Worksheets("SB").Shapes.Item(1).Select
Set objChart = ActiveChart
Worksheets("SB").Shapes.Item(1).Width = Range("A4:M17").Width 'adapter la plage de cellule
Worksheets("SB").Shapes.Item(1).Height = Range("A4:M17").Height 'adapter la plage de cellule
'paste the range into the chart
objChart.Paste
'save the chart as a JPEG
objChart.Export ("D:\Example.Jpeg") 'adapter le chemin
End Sub

bon par contre je ne pense pas qu'ici on puisse poster un fichier excel, ou alors je n'ai pas trouvé comment faire

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

BETBOOM Messages postés 7 Date d'inscription mardi 10 septembre 2019 Statut Membre Dernière intervention 3 juin 2020
3 juin 2020 à 11:52

en gros sur la même et unique feuille qui s'appelle "BTN" j'ai une range (A4:M17) que j'aimerai mettre en image sur la range (U4:AG17) de la même feuille, et que celle-ci s'exporte dans un dossier de mon ordi. J'ai mis png plutot que jpeg car le résultat est de meilleure qualité. Il n'y a pas mieux que le png? il y a le bmp mais la qualité est identique au png apparemment, sauf que l'image est 40 fois plus volumineuse.

cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
3 juin 2020 à 14:42

Comme ceci:

Sub Example()
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
'copy the range as an image
Call Worksheets("BTN").Range("A4:M17").CopyPicture(xlScreen, xlPicture) 'adapter la feuille et la plage de cellule
'remove all previous shapes in sheet2
intCount = Worksheets("BTN").Shapes.Count 'adapter la feuille
For i = 1 To intCount
Worksheets("BTN").Shapes.Item(1).Delete
Next i
'create an empty chart in sheet2
Worksheets("BTN").Shapes.AddChart
'activate sheet2
Worksheets("BTN").Activate
'select the shape in sheet2
Worksheets("BTN").Shapes.Item(1).Select
Set objChart = ActiveChart
Worksheets("BTN").Shapes.Item(1).Top = Range("U4").Top
Worksheets("BTN").Shapes.Item(1).Left = Range("U4").Left
Worksheets("BTN").Shapes.Item(1).Width = Range("U4:AG17").Width 'adapter la plage de cellule
Worksheets("BTN").Shapes.Item(1).Height = Range("U4:AG17").Height 'adapter la plage de cellule

'paste the range into the chart
objChart.Paste
'save the chart as a JPEG
objChart.Export ("D:\Example.Jpeg") 'adapter le chemin
End Sub

Voilà

@+ Le Pivert

Réponse 6 / 6

BETBOOM Messages postés 7 Date d'inscription mardi 10 septembre 2019 Statut Membre Dernière intervention 3 juin 2020
Modifié le 3 juin 2020 à 16:46

merci ta macro fonctionne très bien, par contre juste que quand je l'assigne à mes boutons de commande, elle les supprime une fois la macro effectuée. ci joint mon fichier excel qui prend forme :). en fait c'est apparemment lié au support que tu utilise pour y déposer l'image (sorte d'histogramme), quand il se supprime il supprime aussi mes boutons de commande.

https://www.cjoint.com/c/JFdoLGGqD24

cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
3 juin 2020 à 17:11

Comme ceci:

Sub Example()
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
Dim s As Shape
'copy the range as an image
Call Worksheets("BTN").Range("A4:M17").CopyPicture(xlScreen, xlPicture) 'adapter la feuille et la plage de cellule
'remove all previous shapes sauf button
 For Each s In ActiveSheet.Shapes
      If s.Type <> 8 And s.Type <> 12 Then s.Delete
  Next s
'create an empty chart in sheet2
Worksheets("BTN").Shapes.AddChart
'activate sheet2
Worksheets("BTN").Activate
'select the shape in sheet2
Worksheets("BTN").Shapes.Item(1).Select
Set objChart = ActiveChart
Worksheets("BTN").Shapes.Item(1).Top = Range("U4").Top
Worksheets("BTN").Shapes.Item(1).Left = Range("U4").Left
Worksheets("BTN").Shapes.Item(1).Width = Range("U4:AG17").Width 'adapter la plage de cellule
Worksheets("BTN").Shapes.Item(1).Height = Range("U4:AG17").Height 'adapter la plage de cellule

'paste the range into the chart
objChart.Paste
'save the chart as a JPEG
objChart.Export ("D:\Example.Jpeg") 'adapter le chemin
End Sub

@+ Le Pivert