Récupérer tous les graphs image

[Celeda]

Bonjour,

Je me sers de cette excellente procédure de JW pour récupérer tous les graphs d'une feuille en image gif, qui se sauvegardent dans le fichier en cours.
Je les récupère ensuite pour les coller dans un doc ppt.

Mes désirs : pensez-vous qu'il est possible d'ajouter une ligne ou deux de codes, pour que :

a) je puisse en un seul clique lui demander de me récupèrer

d'un seul coup TOUS les graphs de mon classeur (soit (8 feuilles * 3 graphs) + (10 feuilles *1 graph= 34)

b) avec boite de dialogue pour selectionner de quelle page à quelle page je désire récupérer en image gif et sauvegarder.




???? A l'avance un grand merci
voici la procédure de :

Sub SauveGraphiqueAuFormatGif2() 'JW
Dim ChtObj As ChartObject
Dim Counter As Long
For Each ChtObj In ActiveSheet.ChartObjects
With ChtObj
.Chart.Export .Parent.Name & " " & .Name & ".gif", "GIF"
End With
Counter = Counter + 1
Next ChtObj
MsgBox Counter & " graphiques sauvegardés dans " & CurDir
End Sub

Y a pas le feu, je ferme la shop et je reprendrais lundi.

Bon week à tout le monde.

 

[Pierrot93]

Re : Récupérer tous les graphs image

Bonjour Celeda,

j'ai rajouté une petite boucle, qui permet de boucler sur toutes les feuilles du classeur actif, et s'il existe un graphique effectue le transfert en gif :

Sub SauveGraphiqueAuFormatGif2() 'JW
Dim ChtObj As ChartObject, ws As Worksheet
Dim Counter As Long
For Each ws In Worksheets
For Each ChtObj In ws.ChartObjects
With ChtObj
.Chart.Export .Parent.Name & " " & .Name & ".gif", "GIF"
End With
Counter = Counter + 1
Next ChtObj
Next ws
MsgBox Counter & " graphiques sauvegardés dans " & CurDir
End Sub

Petite question, pourquoi une boite de dialogue pour selectionnner des numéros de feuilles, il y a des graphiques que tu ne veux pas voir exporter ?

bonne fin d'après midi
@+

 

[Zon]

Re : Récupérer tous les graphs image

Salut Marie et le forum,

de gros bisous depuis le temps que nous nous sommes croisés

Si tu ne trouves pas de contributeurs pour ton appli courielles moi comme au bon vieux temps.


A+++

 

[Celeda]

Re : Récupérer tous les graphs image

Bonjour,


oulhal lahla lah Pierrot!!! super cela fonctionne au poil!! et plus fort que Zorro!! le chat!!

Merci beaucoup.

Pourquoi j'ai besoin d'une boite de dialogue , parce que dans ce fichier, j'ai des récap mensuelles, ok mais des récap trimestrielles et donc semestrielles.

Donc tous les mois, je récupère les graphs mensuels et la procédure me permettrait de ne pas stocker pour rien des graphs. Je ne place les graphs trimestriels que tous les trois mois soit le mois 04, le mois 07 ect...et idem pour les semestres. Suis-je bien claire ?



AH aha ah Fabrice, toujours aussi vaillant!!! merci mais je suis déjà en prise !!lol par Pierrot!!

ah je te signale Fabrice, que la saison est ouverte pour la piscine ==> un peu froide je l'avoue mais ce week elle sera à 24 ou 26!! et là plongeon!! donc si tu passes par chez moi n'hesite pas!!!

 

[Pierrot93]

Re : Récupérer tous les graphs image

Re Celeda, bonjour Zon

y a t il une constante qui pourrait être utilisée dans le nom de tes feuilles ou dans le contenu, nous permettant de cibler automatiquement les feuilles à traiter par rapport au mois en cours ?

Sinon si les feuilles que tu veux traiter se suivent tout le temps, nous pouvons procéder comme suit :

Sub SauveGraphiqueAuFormatGif2() 'JW
Dim ChtObj As ChartObject, ws As Worksheet
Dim Counter As Long, d As Byte, f As Byte

d = Application.InputBox("Indiquez le numéro de la première feuille à traiter", , , , , , , 1)
f = Application.InputBox("Indiquez le numéro de la dernière feuille à traiter", , , , , , , 1)
If d = 0 Or f = 0 Or f < d Then MsgBox "Au moins un numéro de feuille est erroné!!! ": Exit Sub

For Each ws In Worksheets
    If ws.Index >= d And ws.Index <= f Then
        For Each ChtObj In ws.ChartObjects
            With ChtObj
            .Chart.Export .Parent.Name & " " & .Name & ".gif", "GIF"
            End With
            Counter = Counter + 1
        Next ChtObj
    End If
Next ws
MsgBox Counter & " graphiques sauvegardés dans " & CurDir
End Sub

A toi de me dire...

bonne soirée
@+

 

[Celeda]

Re : Récupérer tous les graphs image

Bonsoir,

Et bien je te le dis Pierrot :

Sinon si les feuilles que tu veux traiter se suivent tout le temps, nous pouvons procéder comme suit :

je vais procéder comme tu l'as fait car elles se suivent.

Je teste dés lundi et à l'avance parce que je pense que cela fonctionnera, un merci pleins de becs.

(je suis toujours très humble et très confuse quand on m'aide, c'est fou!! )

 

[Pierrot93]

Re : Récupérer tous les graphs image

Bonjour Celeda

Avant de découvrir ton message, au cas ou les feuilles ne se suivraient pas, j'avais également penser à une solution via un UserForm. Elle est faite, alors je vais tout de même te la soumettre, et puis cela pourrra peut être servir à quelqu'un d'autre...

Tu prends l'USF dans le fichier joint et tu le mets dans ton classeur. Le code qui le lance est placé dans le module de la feuille (feuil1).

Attention le code est exécuté sur le classeur actif.

bonne journée et bon week end.
@+

 

[Celeda]

Re : Récupérer tous les graphs image

Bonjour,

Merci pour ton anticipation, Pierrot===> je teste cela lundi et je te fais part de mes commentaires.
Et comme tu le dis, j'espère que cela servira à d'autres qui travaillent avec plusieurs graphes dans un classeur avec plusieurs feuilles.

Bon week.

 

[Celeda]

Re : Récupérer tous les graphs image

Bonjour,

Je viens de tout récupèrer et de tout essayer==> Impec.

Merci beaucoup Pierrot.
Bonne semaine.

 

[Gael]

Re : Récupérer tous les graphs image

Bonsoir Celeda, bonsoir Zon, bonsoir Pierrot,

Celeda, J'avais un problème similaire et comme tu souhaites coller tes images dans une présentation PPT, j'ai modifié le code de Pierrot (merci Pierrot) en ajoutant un lien avec Power point.

Le code ci-dessous ouvre Powerpoint et crée une nouvelle présentation puis il colle chaque graphe de chaque feuille dans une nouvelle diapo en mettant comme titre le nom de la feuille (mais on peut changer facilement) et le graphe à l'échelle de la diapo quelle que soit sa taille.

Sur mes exemples, ça marche très bien, j'espère que ce sera général.

Sub GraphPPT()
Dim appWD As PowerPoint.Application
Dim ChtObj As ChartObject, ws As Worksheet
Dim scount As Integer

Application.ScreenUpdating = False
Set appWD = CreateObject("powerpoint.Application")
appWD.Visible = True
appWD.Presentations.Add

For Each ws In Worksheets
For Each ChtObj In ws.ChartObjects
scount = scount + 1
ChtObj.CopyPicture
appWD.ActivePresentation.Slides.Add(Index:=scount, Layout:=ppLayoutTitleOnly).Select
appWD.ActivePresentation.Slides(scount).Shapes(1).IncrementTop -20
appWD.ActivePresentation.Slides(scount).Shapes(1).ScaleHeight 0.6, False, msoScaleFromTopLeft
appWD.ActivePresentation.Slides(scount).Shapes(1).TextFrame.TextRange.Text = ws.Name
appWD.ActivePresentation.Slides.Item(scount).Shapes.Paste
With appWD.ActivePresentation.Slides(scount).Shapes(2)
.LockAspectRatio = False
.Height = 450
.Width = 680
.Left = 20
.Top = 80
End With
Next ChtObj
Next ws

Application.ScreenUpdating = True
End Sub

Le code est assez simple mai sla mise au point n'a pas été si facile que ça!

@+

Gael

 

[Celeda]

Re : Récupérer tous les graphs image

Bonjour,

Merci Gael.

J'ai une erreur de compilation sur appWD As PowerPoint.Application,
Il me dit type non défini ????

 

[Pierrot93]

Re : Récupérer tous les graphs image

Bonjour Celeda, Gael, Zon

Sauf erreur, il me semble qu il faut activer la référence Microsoft PowerPoint XX.0 Object library dans l'éditeur VBE. Barre de menu => Outils Référence et tu coches la référence indiquée plus haut ou "XX" représente ta version Office.

bon après midi.
@+

 

[mutzik]

Re : Récupérer tous les graphs image

Bonjour Marie, Pierrot, Fabrice, Gael,

Quant à moi qui ai plein (une bonne dizaine) d'applis tournant de cette manière, j'ai fait
1. je crée mes graphs dans Excel
2. je fais un copier / collage spécial avec liaison dans mon ppt
3. les datas sont mises à jour avant la réunion de production des superviseurs, et quand ils arrivent tout est à jour

quand ils veulent visualiser la présentation, il ne font pas la mise à jour des données.
NB : lors de la mise à jour des données et du ppt, il est conseillé d'ouvrir le xls avant, sur mon appli principale d'une 40ne de graphs, cela prend à peu près 10sec pour actualiser les données

 

[Gael]

Re : Récupérer tous les graphs image

Bonjour à tous,

Oui, merci Pierrot, c'est bien ça et j'avais oublié ce détail.

Mutzik, dans mon code, j'ai fait un copypicture pour ne pas avoir de liaison, mais c'est facilement modifiable, Celeda, si tu préfères avoir un collage avec liaison.

On peut aussi facilement appliquer un autre modèle ou modifier légèrement le modèle par défaut pour ne pas avoir les instructions ...increment top -20 et ...scaleheight 0.6 qui ne servent qu'à ajuster la zone de titre, ce qui est sans intérêt.

La prochaine fois, Mutzik, je t'écrirai directement pour avoir quelques exemples, ce sera plus facile!

@+

Gael

 

[Celeda]

Re : Récupérer tous les graphs image

Bonjour,

G E N I A L !!!!!! ton truc!!!

en plus cela vient de me donner une nouvelle idée!!!! M E R C I!!

(mais que je suis-je bête avec cette histoire de réf ==> je n'ai pas le
reflexe à chaque fois!!!)


Bertrand : je ne veux pas de liaison ==> sinon les gens vont tapoter dans mes formules et changer mes résultats, par erreur et pour l'avoir vécu une fois, je ne souhaite pas qu'ils aient cet accès.

D'autre part, l'exemple est un peu plus complexe ==> j'ai des feuilles avec 3 graphs et d'autres avec 2, et d'autres avec 4, et ils doivent être dans une seule slide.

Mais cela me suffit amplement (entre l'aide et les idées), je peux vous assurer que je suis comblée et je vous remercie tous de votre aide.