Discussion :

[raptoresse]

Bonjour tout le monde !

Je suis face à une problème et je compte sur vous pour m'aider à le résoudre

J'ai écrit une macro afin de transformer un graphique d'une feuille excel en image, et d'enregistrer cette image en format .gif et en format .jpg sur mon disque dur. J'ai donc 2 fichiers images qui sont créés par graphique.
Maintenant je souhaiterai contrôler la taille de l'image créé en format .jpg, afin d'avoir une image plus grande que celle enregistré par défaut en format .gif.

Savez-vous comment procéder ?

Je précise que je suis totalement novice en VBA... Ci dessous ma macro qui me créé bien 2 fichiers images par graphique excel, manque plus qu'à rajouter la ligne de code pour controler la taille du fichier .jpg, c'est là que j'ai besoin d'aide !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub ExportChart()
     '   Export a selected chart as a picture
    Const sSlash$ = "/"
    Const sPicTypeJPG$ = ".jpg"
    Const sPicTypeGIF$ = ".gif"
    Dim sChartName$
    Dim sPath$
    Dim sBook$
    Dim objChart As ChartObject
              On Error Resume Next
     '   Test if there are even any embedded charts on the activesheet
     '   If not, let the user know
    Set objChart = ActiveSheet.ChartObjects(1)
    If objChart Is Nothing Then
        MsgBox "No charts have been detected on this sheet", 0
        Exit Sub
    End If
               '   Test if there is a single chart selected
    If ActiveChart Is Nothing Then
        MsgBox "You must select a single chart for exporting ", 0
        Exit Sub
    End If
 
     sChartName = Left(ActiveWorkbook.Name, 6) & "-trend"
 
 
          '   Test for Cancel button
    If sChartName = "False" Then
        Exit Sub
    End If
          '   If a name was given, chart is exported as a picture in the same
     '   folder location as their current file
    sBook = ActiveWorkbook.Path
    sPathGIF = sBook & sSlash & sChartName & sPicTypeGIF
    sPathJPG = sBook & sSlash & sChartName & sPicTypeJPG
    ActiveChart.Export Filename:=sPathGIF, FilterName:="GIF"
    ActiveChart.Export Filename:=sPathJPG, FilterName:="JPG"
 
     End Sub

Merci !!

[NEC14]

Bonjour,

Peut-être une réponse ici : http://boisgontierjacques.free.fr/pa.../lesimages.htm
Cdt

[eric4459]

Bonjour, bonjour le forum
J'ai eu un problème similaire j'ai trouvé une solution grâce au forum.
En fait il m'a fallu préciser l'étendue des cellules où je voulais placer mon graphique, pour moi une courbe.
Il faut donc ajouter au début de ton code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 Dim Curve As Worksheet
            Set Curve = ThisWorkbook.Sheets("Curve")
            Dim Grph As ChartObjects
            Dim Emplacement As Range
            Dim G As Integer
            Set Grph = Curve.ChartObjects()
            Set Emplacement = Range("B2:P38")

Ceci a positionné et dimensionné mon graphique comme je le souhaitais

Dans une autre procédure j'ai enregistré directement mon graphique en jpg pour ensuite l'insérer dans un UserForm

Pour l'enregistrement voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set Grph = Curve.ChartObjects(1).Chart
Grph.Export Filename:="C:\Ton Chemin\Graphique1.jpg", filtername:="JPG"

J’espère que cela répond à ta demande
Eric

[raptoresse]

ok merci beaucoup ! je vais tester et je reviens vers vous

[eric4459]

Rebonjour,

J'ai oublié une partie du code, voici mon code avec ce qui peut t’intéresser en bleu

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Curve_Actual()

            Dim Curve As Worksheet
            Set Curve = ThisWorkbook.Sheets("Curve")
            Dim Grph As ChartObjects
            Dim Emplacement As Range
            Dim G As Integer
            Set Grph = Curve.ChartObjects()
            Set Emplacement = Range("B2:P38")
            Curve.Select
            G = ActiveSheet.ChartObjects.Count
            If G > 0 Then
            ActiveSheet.ChartObjects(G).Delete
            End If
            ActiveSheet.Shapes.AddChart.Select
            ActiveChart.ChartType = xlLine
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(1).Name = "=""Cum. Planned"""
            ActiveChart.SeriesCollection(1).Values = "=Data!$J$8:$BZ$8"
            ActiveChart.SeriesCollection(1).XValues = "=Data!$J$6:$BZ$6"
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(2).Name = "=""Cum. Actual"""
            ActiveChart.SeriesCollection(2).Values = "=Data!$J$14:$BZ$14"
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(3).Name = "=""Cum. Forecast"""
            ActiveChart.SeriesCollection(3).Values = "=Data!$J$20:$BZ$20"
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(4).Name = "=""Planned"""
            ActiveChart.SeriesCollection(4).Values = "=Data!$J$7:$BZ$7"
            ActiveChart.SeriesCollection(4).AxisGroup = 2
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(5).Name = "=""Actual"""
            ActiveChart.SeriesCollection(5).Values = "=Data!$J$13:$BZ$13"
            ActiveChart.SeriesCollection(5).AxisGroup = 2
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(6).Name = "=""Forecast"""
            ActiveChart.SeriesCollection(6).Values = "=Data!$J$19:$BZ$19"
            ActiveChart.SeriesCollection(6).AxisGroup = 2
            ActiveChart.Axes(xlValue).Select
            ActiveChart.Axes(xlValue).MaximumScale = 1
            ActiveChart.ChartGroups(2).GapWidth = 0
            ActiveChart.SeriesCollection(4).ChartType = xlColumnClustered
            ActiveChart.SeriesCollection(5).ChartType = xlColumnClustered
            ActiveChart.SeriesCollection(6).ChartType = xlColumnClustered
            
            With Grph
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
            End With
End Sub

Puis dans un autre module, ou à la suite

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set Grph = Curve.ChartObjects(1).Chart
Grph.Export Filename:="C:\Ton Chemin\Graphique1.jpg", filtername:="JPG"

Désolé pour l'oubli

Eric

[kiki29]

Salut, tout était déjà dans la FAQ, il suffisait d'être curieux et de chercher
http://excel.developpez.com/faq/?pag...ionneGraphique
http://excel.developpez.com/faq/?pag...ursgraphsImage
etc...

[eric4459]

Salut, tout était déjà dans la FAQ, il suffisait d'être curieux et de chercher
http://excel.developpez.com/faq/?pag...ionneGraphique
http://excel.developpez.com/faq/?pag...ursgraphsImage
etc...

kiki29,
C'est vrai mais c'est tellement plus rapide de poster et puis cela peut être gratifiant de pouvoir aider les autres pour ceux qui répondent...
Cela permet également de revenir sur des points abordés il y a un certains temps et se le remémorer..
Eric

[raptoresse]

C'est bon merci beaucoup ca marche !

Par contre, ça me modifie la taille de mon graphe sur ma page excel, hors je souhaite agrandir le graphe seulement dans l'image .jpg créée, et non sur mon classeur excel.
Savez-vous comment résoudre ce problème ?
par exemple je pense à faire une manip du style agrandissement du graphe, enregistrement du fichier png associé, puis retour à la taille/position initiale...Mais je ne sais vraiment pas comment coder ça... Un petit coup de main svp ?

et kiki29, j'avais vu ces pages, mais je pensais pas que ca pouvait résoudre mon problème...

[eric4459]

Bonjour,
Tu peux essayer ceci, j'ai testé sur mon programme et cela fonctionne, à placer après les lignes où tu enregistre ton graphique:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
PageGraph.Select ' Ici tu sélectionne la page où se trouve le graphique
 Set Emplacement = Range("B2:G13") ' en fait ici tu place ton graphique pour qu'il couvre la surface comprise entre les cellules B2 et G13 de ta feuille ( tu peux adapter)
With Grph
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
End With

Eric

PS: n'oublie pas de cliquer sur le bouton "Résolu" si c'est le cas

[raptoresse]

Merci pour ton aide.

Le problème est que je voudrai appliquer la macro sur un très grand nombre de fichier excel, mais a chaque fois le graphe n'est pas à la même position.

Du coup je cherche une commande où je n'aurai pas besoin de lui indiquer une position, mais juste de revenir à la taille/position initiale, avant agrandissement pour la transformation en .jpg.

Est-ce possible ?

[eric4459]

Rebonjour,
Désolé mais pour cela je n'ai pas d'idée pour rendre cette fonction valide quelle que soit la position du graphe et de plus sur plusieurs fichier.
Il y aura peut-être quelqu'un sur le forum qui pourra t'aider mieux que moi pour ce sujet.
Essayes d'ouvrir un autre post avec ce nouveau problème.
Eric

[raptoresse]

et de plus sur plusieurs fichier.

ca ça n'a pas d'importance, je vais appliquer la même macro sur tous les fichiers.
Mais du coup il ne faut pas que je spécifie des numéros de case pour le retour à la taille/position initiale...

Je vais lancer un nouveau sujet alors, cest vrai qu'on a un peu dévié...

Merci !

[eric4459]

Essayes ceci
C'est basé sue ce que je viens de trouver sur http://excel.developpez.com/faq/?pag...aphiqueFeuille

En début de code tu as du écrire quelquechose du genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Grph = Curve.ChartObjects()

Curve étant le nom de l'onglet

Après création de ton graphique

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Range("A1") = Grph.TopLeftCell.Address
Range("A2")= Grph.BottomRightCell.Address

Ensuite tu redimensionne pour avoir ton graphe au format désiré
puis tu ajoutes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Emplacement = Range("A1").Value & ":" & Range("A2").Value

Mais en essayant de tester je bloque sur "Range("A1") = Grph.TopLeftCell.Address" , un message me dit que les propriété ou la méthode n'est pas gérée par l'objet

A suivre

Eric

[eric4459]

Bonjour,
Il y a aussi cette solution mais ce n'est peut-être pas la meilleure:
Ton code crée ton graphique
Tu le redimensionnes
tu l'enregistres
tu l'effaces
tu recréés ton graphique

Pour effacer voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 Dim G As Integer
G = ActiveSheet.ChartObjects.Count
'ici ton code pour créér
'ici ton code pour redimensionner
If G > 0 Then
            ActiveSheet.ChartObjects(G).Delete
End If
'Ici ton code pour créér ton graphique

C'est une "Bidouille" mais cela devrait fonctionner
Tiens moi au courant
Eric

[raptoresse]

Ok merci Eric, sinon en fait j'ai trouvé un moyen pour pas que ca modifie la taille de mon graphique excel : tout simplement ne pas enregistrer les modifications sur mon document en le fermant

Merci bien en tout cas ! je clique sur "résolu"