Exporter des images en vba

Version imprimable

bonjour,
je suis débutant en vba et j'essaie d'exporter 2 résultats en image jpg
le programme fonctionne pour la 1ere exportation mais pas pour la seconde où ca coince au niveau de chart2.Paste

quelqu'un aurait il la solution
merci

mon programme :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub exporte_image()
Dim Plage1 As Range
Dim Plage2 As Range
Dim chart1 As Object
Dim chart2 As Object
With Sheets("Feuil1")
    Set Plage1 = .Range("A2:K68")
    Plage1.CopyPicture
    Set chart1 = .ChartObjects.Add(Plage1.Left, Plage1.Top, Plage1.Width, Plage1.Height).Chart
    chart1.Paste
    chart1.Export "d:\image_1.jpg", "jpg"
    .ChartObjects.Delete
 
    Set Plage2 = .Range("A69:K180")
    Plage2.CopyPicture
    Set chart2 = .ChartObjects.Add(Plage2.Left, Plage2.Top, Plage2.Width, Plage2.Height).Chart
    chart2.Paste
    chart2.Export "d:\image_2.jpg", "jpg"
End With
End Sub

Bonjour,

A partir d'une adaptation du code trouvé dans la FAQ
http://excel.developpez.com/faq/?pag...apier#Snapshot

J'ai décomposé votre code en deux macros. L'une pour générer une image, l'autre pour lancer cette macro et l'appliquer sur vos deux zones.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub Tester_Exporte_Image()
 
Dim AireACopier As Range
Dim RepertoireSauvegarde As String
Dim NomDeLImageASauvegarder As String
 
  RepertoireSauvegarde = "C:\Users\Eric\Documents\VBA Excel\Développez-Com\Images\Sauvegarde d'images\"
 
  Set AireACopier = ActiveSheet.Range("A2:K68")
  NomDeLImageASauvegarder = "Image1.jpg"
 
  Call Exporte_Image(AireACopier, RepertoireSauvegarde, NomDeLImageASauvegarder)
 
  Set AireACopier = Nothing
 
  Set AireACopier = ActiveSheet.Range("A69:K180")
  NomDeLImageASauvegarder = "Image2.jpg"
 
  Call Exporte_Image(AireACopier, RepertoireSauvegarde, NomDeLImageASauvegarder)
 
 Set AireACopier = Nothing
 
 
 
End Sub
 
 
Sub Exporte_Image(PlageACopier As Range, Chemin As String, NomImage As String)
 
Dim ShapeImage As Shape
Dim Chart1 As Chart
 
 
 
    With ActiveSheet
 
            PlageACopier.CopyPicture
            .Paste
            Set ShapeImage = .Shapes(.Shapes.Count)
 
            Set Chart1 = .ChartObjects.Add(ShapeImage.Left, ShapeImage.Top, ShapeImage.Width, ShapeImage.Height).Chart
            With Chart1
                .Paste
                .Export Chemin & NomImage, "jpg"
            End With
 
            .ChartObjects(ActiveSheet.ChartObjects.Count).Delete
            .Shapes(ActiveSheet.Shapes.Count).Delete
 
            Set Chart1 = Nothing
            Set ShapeImage = Nothing
 
   End With
 
End Sub

Cordialement.

13/05/2013, 21h52
franck211

cela marche

merci beaucoup

Plage blanche

Bonjour Eric, Bonjour le Forum,

(désolé pour mon absence)

Eric,

J'ai testé ton code pour un champ contenant un shape et du texte
La première fois : impeccable
A partir de la deuxième fois : la zone est blanche ?

En exécutant pas à pas, une image est bien créée mais
à la ligne

Code:

Set Chart1 = .ChartObjects.Add(ShapeImage.Left, ShapeImage.Top, ShapeImage.Width, ShapeImage.Height).Chart

une autre, blanche, apparaît et c'est elle qui est exportée.

Voici le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub Tester_Exporte_Image()
 
Dim AireACopier As Range
Dim RepertoireSauvegarde As String
Dim NomDeLImageASauvegarder As String
 
  RepertoireSauvegarde = ThisWorkbook.Path
 
  Set AireACopier = Worksheets("Utilitaires").Range("en_tête_évol_CA")
  NomDeLImageASauvegarder = "Image1.jpg"
 
  Call Exporte_Image(AireACopier, RepertoireSauvegarde, NomDeLImageASauvegarder)
 
 
 Set AireACopier = Nothing
 
 
 
End Sub
 
 
Sub Exporte_Image(PlageACopier As Range, Chemin As String, NomImage As String)
 
Dim ShapeImage As Shape
Dim Chart1 As Chart
 
     With ActiveSheet
 
            PlageACopier.CopyPicture
            .Paste
            Set ShapeImage = .Shapes(.Shapes.Count)
 
            Set Chart1 = .ChartObjects.Add(ShapeImage.Left, ShapeImage.Top, ShapeImage.Width, ShapeImage.Height).Chart
            With Chart1
                .Paste
                .Export Chemin & "\" & NomImage, "jpg"
            End With
 
            .ChartObjects(.ChartObjects.Count).Delete
            .Shapes(.Shapes.Count).Delete
 
            Set Chart1 = Nothing
            Set ShapeImage = Nothing
 
   End With
 
End Sub

Quelque chose doit m'échapper.

Merci par avance

01/06/2018, 16h08
Invité

Citation:

Envoyé par MarcelG

Bonjour,

Ta zone Range("en_tête_évol_CA") correspond bien à la zone que tu veux exporter ?
01/06/2018, 17h28
patricktoulon

re

re
tient tient 2010 aussi ?????
aurais tu W10 comme system d'exploitation?
toujour est il que le probleme est l'acces au chart apres sa creation qui semble perturbé dans les versions 2016 2013 et maintenant 2010 quand elle tournent avec Windows 10
d'ou cette image blanche

j'ai mis cela dans les contributions qui semble fonctionner de 2017 a 2016 sur W 7,8,10
https://www.developpez.net/forums/d1.../#post10176781
01/06/2018, 17h54
MarcelG

Hé, Salut Patrick!

B... de M.....!!!

J'ai essayé 10 fois et cela fonctionne!

Dans mes - modestes - réponses, je dis toujours

Citation:

Relis le code, ligne par ligne, presque mot à mot, en t'octroyant tous les moyens pour comprendre et reviens si nécessaire

Autant te dire "A l'année prochaine"

Les Array, Dictionnaires, Formulaires..., je veux bien mais là!

Merci Patrick.

Bon week-end à tous.