Copie de graphiques

Bonjour à tous !

J'utilise un classeur Excel composé d'une dizaine de feuilles. Sur chaque feuille "s'empilent" verticalement un nombre plus ou moins important de graphiques.

J'ai créé une procédure VB qui se charge de parcourir chaque feuille du classeur, et de copier/coller chaque graphique sur un document Powerpoint (1 graphique = 1 diapo). Mon code semble fonctionner relativement bien, mais je rencontre un problème pour certains graphiques présents sur des feuilles qui en contiennent beaucoup.

Ainsi, l'une des feuilles du classeur (qui n'est pas la dernière parcourue dans la procédure) contient 101 graphiques, et dans l'exécution de la procédure, les 33 derniers (en partant du haut de la feuille) semblent être copiés dans Powerpoint, mais y apparaissent sous la forme d'une image vide (je procède à un collage spécial). Les graphiques des feuilles suivantes se copient correctement.

Je rajouterai que parmi les graphiques de la feuille en question, le dernier copié avant ceux qui donnent des images vides n'est pas copié correctement non plus. Seule la partie haute du graphique apparaît dans l'image résultante de la copie sur Powerpoint.

Voici un extrait du code VBA utilisé :

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

' Déclarations Dim PptApp As PowerPoint.Application Dim PptDoc As PowerPoint.Presentation Dim PptSlide As PowerPoint.Slide Dim PptShape As PowerPoint.Shape   ' Ouverture Powerpoint Set PptApp = New PowerPoint.Application PptApp.Visible = True   ' Ouverture du document powerpoint à modifier Set PptDoc = PptApp.Presentations.Open(nom_fichier)   ' Initialisation de l'index diapo qui marque le début de la copie dans Powerpoint index_diapo = x   ' Pour chaque feuille du classeur For i = 0 nb_feuilles   ' Sélection de la feuille Sheets(i).Select   ' Pour chaque graphique de la feuille For Each graphique In ActiveSheet.ChartObjects   ' Copie le graphique graphique.Activate ActiveChart.ChartArea.Select ActiveChart.ChartArea.Copy   ' Création d'une nouvelle diapo dans Powerpoint PptApp.Activate PptApp.ActiveWindow.ViewType = ppViewSlide Set PptSlide = PptDoc.Slides.Add(index_diapo, ppLayoutLargeObject)   ' Sélection de la zone de la diapo destinée à recevoir le graphique PptSlide.Select PptSlide.Shapes(1).Select   ' Collage du graphique dans la nouvelle diapo PptApp.ActiveWindow.View.PasteSpecial (ppPasteMetafilePicture)   ' Incrémentation de l'index diapo index_diapo = index_diapo + 1   Next   Next

---

Ma principale piste pour le moment est un éventuel problème de presse-papier (je copie au total environ 260 graphiques). Lorsque je limite l'exécution de la procédure au parcours de la feuille qui pose problème, tout se passe bien lors de la copie pour les graphiques qui posaient problème précédemment.
Néanmoins, j'ai du mal à comprendre pourquoi l'exécution complète peut poser problème sur les 33 dernières copies d'une feuille alors qu'elle ne rencontre aucun souci pour les feuilles qui suivent.

Dans le sens d'un problème de presse-papier, j'ai tenté de le vider avant chaque copie de graphique avec :

Code:

---

1 2 3 4

OpenClipboard 0 EmptyClipboard CloseClipboard

---

(source)

J'ai également tenté avec :

Code:

---

application.cutcopymode=false

---

Tout ceci sans succès :(

J'espère avoir été clair, et bien sûr désolé si cette question a déjà été évoquée ici.

bonjour Halzard le forum peut être comme cela

Code:

---

1 2	On Error Resume Next Application.CommandBars("clipboard").Controls(4).Execute

---

Salut laetitia et merci pour ta réponse. Je viens de tester en plaçant cette instruction au début de la boucle de parcours des graphiques, mais le résultat obtenu est le même.

PS : Sans le "on error resume next", VB me signale un problème d'indice (4).

re peut être le mettre juste avant ton premier next

Code:

---

1 2 3 4 5 6 7 8 9

' Collage du graphique dans la nouvelle diapo PptApp.ActiveWindow.View.PasteSpecial (ppPasteMetafilePicture)   ' Incrémentation de l'index diapo index_diapo = index_diapo + 1 On Error Resume Next Application.CommandBars("clipboard").Controls(4).Execute next next

---

Ca ne marche pas non plus malheureusement :?

C'est sensé faire quoi au juste ?

re normalement vider le presse papier il faut peut être faire une boucle specifique pour la feuille qui pose probleme

Salut à tous !

Je me permet de remonter ce sujet car, après de nombreux essais, je n'ai toujours pas réussi à résoudre ce problème. Globalement, je n'ai pas eu l'impression de parvenir à vider le presse papier avec les différentes méthodes que j'ai pu tester.

Le problème n'a peut-être aucun rapport avec le presse-papier ?

Bonjour,

As-tu tenté d'utiliser les 2 méthodes que tu as testées, simultanément ?

Code:

---

1 2 3 4 5 6 7 8 9

Private Declare Function OpenClipboard Lib "user32"(ByVal hwnd As Long) As Long Private Declare Function EmptyClipboard Lib "user32" () As Long Private Declare Function CloseClipboard Lib "user32" () As Long   Sub ViderLePressePapier() OpenClipboard 0 EmptyClipboard CloseClipboard End Sub

---

et

Code:

---

Application.CutCopyMode=False

---

Essaie avec les 2 au bon endroit. D'ailleurs les 2 s'occupent du presse-papier donc, si jamais cela ne fonctionne pas, le problème vient d'autre part.

Rajoute aussi

Code:

---

Application.DisplayAlerts = False

---

au début de ta Sub et

Code:

---

Application.DisplayAlerts = True

---

à la fin. sait-on jamais :roll:

Ah oui, tant qu'à faire, rajoute ce qu'a proposé laetitia (que je salue :P) en même temps. En bref, mets les 3 méthodes en même temps au bon endroit et vois ce que cela donne.

Code:

---

1 2 3 4

Sub ViderLePressePapier() On Error Resume Next Application.CommandBars("Clipboard").Controls(4).Execute End Sub

---

Par contre, mets bien une majuscule à "Clipboard" même si je n'ai aucune idée de l'incidence que cela peut avoir 8O

Re,

Je mets un nouveau post sinon ça risque d'être long et trop confus et, surtout, on risque de ne plus voir les EDITS :roll:

Après avoir testé tout ce que je viens de donner pour le presse-papier, je pense qu'on peut écarter cette origine pour le problème.

J'avais oublié, lors des tests précédents, ajoute la librairie "Microsoft Form 2.0 Object Library." dans les références. Mais bon, je ne suis toujours pas convaincu que cela vienne du presse-papier vu que chaque copier est censé remplacer le précédent dans le presse-papier donc pas de saturation à ce niveau.

Tu peux tester, pour ce qui est de la copie des graphiques, quelque chose du genre :

Code:

---

1 2 3 4 5 6

Sub Envoi() With New DataObject .SetText "TrucACopier" .PutInClipboard End With End Sub

---

C'est manuel, c'est moche mais ça envoie dans le presse-papier. Bien sûr, remplace le SetText par ce qu'il te faut pour les Charts. Ensuite, tu peux coller comme ça :

Code:

---

1 2 3

Sub AvecSendKey() Application.SendKeys "^{v}" End Sub

---

Tu envoies Ctrl + V à la main. Ou sinon :

Code:

---

1 2 3 4 5

Sub Colle() Dim Presspp As New DataObject Presspp.GetFromClipboard Range("A1") = Presspp.GetText End Sub

---

Il va falloir adapter mais tu peux tester ça voir si ça ne s'arrange pas. Bien entendu, rajoute la librairie dont j'ai parlé précédemment et vide le presse-papier de temps en temps avec

Code:

---

Application.CutCopyMode = False

---

Après tout ça, cela marchera peut-être.

Petite question sur le fonctionnement du presse-papier : est-ce le même pour PowerPoint et Excel ou doit-on vider les 2 ? Encore une idée en passant...

Enfin, j'ai lu quelque part que les copier-coller de plages trop importantes puvent parfois poser problème. Ce n'est pas ton cas vu que tu copies un par un les Charts d'après ton code. Je ne pense donc pas à un problème de copier-coller. Peux tu mettre des compteurs dans ton bout de code pour moi stp ?

Un après

Code:

---

For Each graphique In ActiveSheet.ChartObjects

---

pour voir si ta boucle va bien jusqu'au dernier graphique (histoire de vérifier). Un autre, différent, après

Code:

---

ActiveChart.ChartArea.Copy

---

voir si tous sont copiés. Enfin, un dernier après

Code:

---

PptApp.ActiveWindow.View.PasteSpecial (ppPasteMetafilePicture)

---

Affiche cela à la fin et dis nous.

Enfin, est-ce que les slides sont bien créés par

Code:

---

Set PptSlide = PptDoc.Slides.Add(index_diapo, ppLayoutLargeObject)

---

même si les Charts ne sont pas collés dessus ? Il faut vérifier si le code va jusque là. Et si les slides sont bien créés, vérifie aussi que les bonnes zones sont bien sélectionnées avant le collage.

D'ailleurs, je te propose de remplacer tous tes Select par des Activate. En parlant de ça, vérifie aussi, par ton gestionnaire de tâches, l'utilisation de la mémoire.

Une fois arrivé là, si ça ne marche toujours pas, je me propose de te fournier corde et tabouret :mouarf:

Merci pour ta réponse Dead !

Je viens de faire un test en utilisant tout ceci en même temps, voici ce que ça donne :

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 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77

' Déclarations Dim PptApp As PowerPoint.Application Dim PptDoc As PowerPoint.Presentation Dim PptSlide As PowerPoint.Slide Dim PptShape As PowerPoint.Shape   Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function EmptyClipboard Lib "user32" () As Long Private Declare Function CloseClipboard Lib "user32" () As Long   Sub ViderLePressePapier1()   OpenClipboard 0 EmptyClipboard CloseClipboard   End Sub   Sub ViderLePressePapier2()   On Error Resume Next Application.CommandBars("Clipboard").Controls(4).Execute   End Sub   Sub MaSub ()   Application.DisplayAlerts = False Application.CutCopyMode = False   ' Ouverture Powerpoint Set PptApp = New PowerPoint.Application PptApp.Visible = True   ' Ouverture du document powerpoint à modifier Set PptDoc = PptApp.Presentations.Open(nom_fichier)   ' Initialisation de l'index diapo qui marque le début de la copie dans Powerpoint index_diapo = x   ' Pour chaque feuille du classeur For i = 0 nb_feuilles   ' Sélection de la feuille Sheets(i).Select   ' Pour chaque graphique de la feuille For Each graphique In ActiveSheet.ChartObjects   ' Copie le graphique graphique.Activate ActiveChart.ChartArea.Select ActiveChart.ChartArea.Copy   ' Création d'une nouvelle diapo dans Powerpoint PptApp.Activate PptApp.ActiveWindow.ViewType = ppViewSlide Set PptSlide = PptDoc.Slides.Add(index_diapo, ppLayoutLargeObject)   ' Sélection de la zone de la diapo destinée à recevoir le graphique PptSlide.Select PptSlide.Shapes(1).Select   ' Collage du graphique dans la nouvelle diapo PptApp.ActiveWindow.View.PasteSpecial (ppPasteMetafilePicture)   ' Incrémentation de l'index diapo index_diapo = index_diapo + 1   Call ViderLePressePapier1 Call ViderLePressePapier2   Next   Next   End Sub

---

Malheureusement, cela n'a pas résolu le problème.

Lorsque j'exécute ma macro, je fais en sorte d'afficher le presse-papier d'Excel derrière la fenêtre Powerpoint qui s'ouvre. Ainsi, je constate que le presse papier se remplit au fil des copies de graphiques. Généralement, l'aperçu des objets n'a pas le temps de se charger dans la zone du presse papier, mais je le vois parfois apparaître brièvement pour certains graphiques.

Lorsque la procédure passe sur les graphiques qui posent problème, la zone du presse-papiers m'indique "Aperçu non disponible" pour plusieurs objets.

Edit : ceci est une réponse à ton premier post :)

Bonjour

A priori, c'est qu'il y a trop d'opérations, et certaines n'ont pas le temps de se finir lorsque tu en lances d'autres.

Il faudrait essayer d'utiliser l'instruction DoEvents juste aprés le vidage du Presse papier.

Ce n'est qu'une hypothèse à tester.

Philippe

@ DeaD78 : J'ai fait les vérification via les compteurs est c'est correct, il passe bien par les phases de copy et paste pour chaque graphique. Concernant l'utilisation mémoire, disons que ça varie entre 95 et 100% pendant l'exécution.

@ Philippe JOCHMANS : J'avais effectivement testé avec DoEvents, c'est en fait la première solution qu'on m'a suggéré. J'ai testé à nouveau à divers endroit du code, mais cela ne change rien non plus malheureusement.

Re,

Vu l'utilisation de la mémoire, ça ne peut, à mon avis, venir que de là. Si tu es sûr que tous les tests que je t'ai proposés passent, je ne vois pas énormément de solutions.

Personnellement, je ne pense pas que la solution manuelle que je t'ai proposée qui consistait à faire un copier-coller manuel soit bonne.

Par contre, je vais peut-être avoir une solution pour toi. D'abord, dis-moi si les slides sont bien créés dans le PPT même si rien n'est collé dessus.

Alors voilà ce que je te propose :

Tu comptes le nombre de ChartObjects que tu as dans ton Excel (pour chaque feuille et spécialement celle comportant beaucoup de charts). Je ne connais pas exactement la syntaxe mais ça doit être un petit Count à rajouter à la fin de ActiveSheet.ChartObjects. Sur ce, tu définis une variable globale (disons X dans notre cas). Ensuite, tu définis X = ActiveSheet.ChartObjects.Count / 2 (vérifie si c'est bien ça pour compter). Enfin, au lieu de

Code:

---

For Each graphique In ActiveSheet.ChartObjects

---

tu fais une boucle

Code:

---

For i = 1 to X

---

où tu fais ton traitement pour la première partie des graphes. Et là, tu fermes ta Sub ! Puis tu en ré-ouvres une autre avec exactement le même code mais

Code:

---

For i = X to X*2

---

. Voilà, l'idée est de séparer cela selon 2 Sub différentes que tu appelles dans une dernière Sub principale par des Call. Vide quand même le presse-papier entre les 2 appels histoire de. Ensuite, mets un stop entre les 2 appels et check l'utilisation mémoire.

A mon avis, cela devrait marcher car tu vas couper les plages à copier en 2 donc pas de surcharge. De plus, l'utilisation mémoire devrait baisser du coup.

Tu testes et me dis ?

Tous les slides sont bien créés dans le document Powerpoint, et ils ne sont pas vides mais contiennent une image vide, ou une image coupée (dans le cas du dernier "bon" graphique de la feuille qui pose problème).

Je joint à ce message 2 images pour montrer ce que j'obtiens côté Powerpoint pour ces 2 cas. J'insiste bien : je n'ai qu'une seule diapo avec un graphique coupé.

Voilà en attendant, je vais tester ta méthode avec plusieurs Sub.

PS : pour ce que ça vaut, je pense pouvoir dire que la coupure dans le graphique survient à la ligne 1786 de la feuille Excel. Tous les graphiques en-dessous de cette ligne donnent une image vide dans Powerpoint

Bonjour

Je n'ai pas encore trouvé, l'information, mais est-ce qu'il n'y aurait pas une histoire de taille de fichier ?

Par curiosité, ce que tu as déjà résussi à faire fait quel taille ?

Philippe

Le document Powerpoint généré fait 1 810 Ko, à partir d'un modèle de 97 Ko.

Re

Ok, donc à mon avis ce n'est pas un problème de poids :koi:

Philippe

Re tout le monde,

Je viens de trouver ça en surfant un peu :

Citation:

---

What is the maximum file size for PowerPoint? There is no maximum file size either in file size or number of slides. The system will barf on the file when you run out of memory, so buy lots of memory, particularly if you like to use pictures, sounds, and/or video.

---

D'après ce que je vois, pas de taille maximum mais le "découpage" des graphiques vient sûrement du manque de mémoire. Il va falloir essayer de l'alléger un peu. Essaie la méthode du découpage du traitement en deux procédures distinctes avec un "Idle" au milieu histoire de décharger la pauvre petite mémoire.

PS : en plus, ton PPT n'est pas si gros que ça...

EDIT : as-tu un PC mieux loti en mémoire + processeur sous la main ? Si c'est la cas, fais-y tourner la macro originale. On sera vite fixé si elle va plus loin...

Re

Une idée (peut-être bête, mais à tester).

Tu vas jusqu'à ce que tout va bien, tu fermes ton ppt, tu enregistres, tu les réouvres et tu continues.

Philippe

[Edit] :oops: la même logique que DeaD78, en plusieurs étapes.

Bon ...

Je tiens la solution.

J'ai remplacé la ligne ActiveChart.ChartArea.Copy par ActiveChart.CopyPicture, et cela fonctionne maintenant parfaitement. Pas de problème de presse-papier donc visiblement, pas de problème de mémoire ... une limitation de VB dans l'étendue de la copie de graphique ?

Merci en tous cas pour votre aide et votre participation !