Exporter une image excel dans un dossier

Résolu
BETBOOM Messages postés 7 Statut Membre -  
cs_Le Pivert Messages postés 8437 Statut Contributeur -
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

6 réponses

Réponse 1 / 6
Utilisateur anonyme
 
Bonjour
Allez voir cela https://software-solutions-online.com/excel-vba-save-table-as-jpeg/
A+
0
Réponse 2 / 6
BETBOOM Messages postés 7 Statut Membre
 
merci mais je n'ai pas réussi, ça m'écrit erreur débogage etc.
0
Réponse 3 / 6
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
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...
0
BETBOOM Messages postés 7 Statut Membre
 
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.
0
Réponse 4 / 6
cs_Le Pivert Messages postés 8437 Statut Contributeur 729
 
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à
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
il s'agit d'envoyer une photo ou image dans un dossier et non de l'envoyer sur une feuille...
0
cs_Le Pivert Messages postés 8437 Statut Contributeur 729 > michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention  
 
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!
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318 > cs_Le Pivert Messages postés 8437 Statut Contributeur
 
Pourquoi faire simple quand on peut faire compliqué !
0
cs_Le Pivert Messages postés 8437 Statut Contributeur 729 > michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention  
 
je ne suis pas le demandeur. Je me suis contenté de mettre la macro fournie par le lien opérationnelle!
0
BETBOOM Messages postés 7 Statut Membre
 
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
0

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

Posez votre question
Réponse 5 / 6
BETBOOM Messages postés 7 Statut Membre
 
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.
0
cs_Le Pivert Messages postés 8437 Statut Contributeur 729
 
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
0
Réponse 6 / 6
BETBOOM Messages postés 7 Statut Membre
 
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
0
cs_Le Pivert Messages postés 8437 Statut Contributeur 729
 
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
0