Discussion :

[Eddie69003]

Bonsoir

J'ai une macro qui copie en image des graphiques Excel dans un fichier Powerpoint

J'ai écrit une sub qui définit qui va chercher dans une feuille Excel donnée, le graphique voulu et le colle dans la slide voulue à la bonne place

La copie se passe correctement, les images sont placées au bon endroit dans le fichier powerpoint.

Quand j'exécute la macro, parfois j'ai le message d'erreur "Erreur d'excécution 1004 - Erreur définie par l"objet ou l'application".
Je sélectionne le graphique manuellement, je relance la macro et ça passe ...

Je suppose qu'il y a soit un pb de mémoire ou une variable qui s'initialise mal

Voici le code développé :

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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
 
Option Explicit
 
'Paramètres fichier PowerPoint
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim NbShpe As Integer
 
'Paramètres des Logos
Dim Nom_Image As String
Dim Nom_Logo As String
 
'Paramètres des Graphiques
Dim Nom_Feuille As String
Dim Nom_Graphique As String
Dim Numero_Slide As Integer
Dim Slide_Graph As String
Dim Pos_Hz As Integer
Dim Pos_Vt As Integer
Dim Pos_Ht As Integer
Dim Pos_Lg As Integer
 
Sub ExportXlsxPptx()
 
Application.CutCopyMode = False
 
'Ouverture Maquette Powerpoint
Set PptApp = New PowerPoint.Application
PptApp.Visible = True
Set PptDoc = PptApp.Presentations.Open(ThisWorkbook.Path & "\" & "Maquette 2016 vs 2015.pptx")
 
Workbooks("Données 2016 vs 2015").Activate
 
'Slide 12
Call Ajout_Graph("1 - Profil", "Graphique 1", 12, 111, 304, 119, 88)
Call Ajout_Graph("1 - Profil", "Graphique 2", 12, 111, 304, 416, 88)
Call Ajout_Graph("1 - Profil", "Graphique 3", 12, 111, 304, 119, 280)
 
'Slide 13
Call Ajout_Graph("2 - Profil - PRATIQUANTS", "Graphique 1", 13, 152, 322, -29, 35)
Call Ajout_Graph("2 - Profil - PRATIQUANTS", "Graphique 2", 13, 122, 259, 392, 63)
 
 
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "En Cours 2016 vs 2015.pptx"
PptDoc.Close
PptApp.Quit
 
End Sub
 
Sub Ajout_Graph(Nom_Feuille, Nom_Graphique, Numero_Slide, Pos_Ht, Pos_Lg, Pos_Hz, Pos_Vt)
 
'Nom feuille / Nom Graphique / Numéro Slide / Hauteur / Largeur / Horizontal / Vertical
 
Application.CutCopyMode = False
 
ActiveWorkbook.Sheets(Nom_Feuille).Activate
 
ActiveSheet.ChartObjects(Nom_Graphique).Copy
 
PptDoc.Slides(Numero_Slide).Shapes.PasteSpecial ppPasteEnhancedMetafile
 
NbShpe = PptDoc.Slides(Numero_Slide).Shapes.Count
 
With PptDoc.Slides(Numero_Slide).Shapes(NbShpe)
    .Left = Pos_Hz 'position horizontale dans le slide
    .Top = Pos_Vt 'position verticale dans le slide
    .Height = Pos_Ht 'hauteur image
    .Width = Pos_Lg 'largeur image
End With
 
End Sub

Merci pour votre aide

Eddie

[Dédé6621]

Bonsoir Eddie69003,

À quelle ligne renvoie le message d'erreur?

Cordialement

[Eddie69003]

A la ligne 59, quand je sélectionne le graphique... c'est comme s'il ne le trouvait pas : le graphique existé bien dans l'excel.


Eddie

[Dédé6621]

Et lors de quel appel l'erreur apparaît-elle?

Ligne 36, 37, 38, 41 ou 42?

[unparia]

Bonjour,
si, en mode création, tu cliques-droit sur ton graphique "Graphique 1" (par exemple) puis choisis "affecter une macro", tu vas pouvoir découvrir que son nom d'objet n'est pas "Graphique 1", mais "Graphique1"

[Eddie69003]

Et lors de quel appel l'erreur apparaît-elle?

Ligne 36, 37, 38, 41 ou 42?

cela n'apparait pas toujours sur le même appel ... souvent sur la 3

Bonjour,
si, en mode création, tu cliques-droit sur ton graphique "Graphique 1" (par exemple) puis choisis "affecter une macro", tu vas pouvoir découvrir que son nom d'objet n'est pas "Graphique 1", mais "Graphique1"

j'ai fait le test et c'est bien "Graphique 1", "Graphique1" ne fonctionne pas

[Dédé6621]

Sans grande conviction, essaye peut-être avec l'index du graphe, plutôt qu'avec son nom.

[Eddie69003]

merci pour ton aide mais j'ai également testé et j'ai le même soucis

je vais essayer de "tuer" l'objet "pptdoc.XXX" = nothing à la fin de la sous-sub mais il faut que je définisse l'objet différemment je pense

[Eddie69003]

Bonjour

J'ai résolu mon problème en ajoutant une ligne avant la ligne 59 en sélectionnant l'objet avant de le copier

Avant :

Code :

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

1
2
3
4
5
6
 
ActiveWorkbook.Sheets(Nom_Feuille).Activate
 
ActiveSheet.ChartObjects(Nom_Graphique).Copy
 
PptDoc.Slides(Numero_Slide).Shapes.PasteSpecial ppPasteEnhancedMetafile

Après :

Code :

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

1
2
3
4
5
6
7
8
 
ActiveWorkbook.Sheets(Nom_Feuille).Activate
 
ActiveSheet.ChartObjects(Nom_Graphique).Select
 
ActiveSheet.ChartObjects(Nom_Graphique).Copy
 
PptDoc.Slides(Numero_Slide).Shapes.PasteSpecial ppPasteEnhancedMetafile

Merci à ceux qui ont cherché à m'aider

Eddie