Erreur exécution 2147023170 - échec appel de procédure distante - POWERPOINT 2013

**fidecourt** · 22/02/2013, 14h48

lors de l'éxécution de macros sous EXCEL qui génère des présentations POWERPOINT et les assemble en une seule présentation, j'ai à un moment donné (soit dès la 1ère, soit sur une autre de façon aléatoire), une

ERREUR EXECUTION 2147023170 (800706be) - ECHEC APPEL DE PROCEDURE DISTANTE

j'arrête la macro EXCEL, et j'ouvre POWERPOINT, et là je trouve une présentation "récupérée" que je dois fermer, puis une autre, etc... autant de fois qu'il y a eu de présentations créées par EXCEL

J'ai du mal à comprendre ce qui se passe et quel est le paramètre à modifier dans POWERPOINT 2013, car toutes ces macros fonctionnent parfaitement sous OFFICE 2010.

J'ai un nouveau PC équipé d'une licence OFFICE 2013, et je bute sur cette erreur

je vous joins le code d'une des macros de compilation de présentations, au cas où

merci pour votre aide, car je coince réellement sur ce qu'il y a lieu de faire, et je n'ai rien trouvé dans la doc support sur cette erreur et POWERPOINT 2013.

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
 
Sub ConcatenerPresentations()
Dim Ppa As PowerPoint.Application
Dim Pdevis As PowerPoint.Presentation
Dim PAgr As PowerPoint.Presentation
Dim PRecap As PowerPoint.Presentation
Dim PCouleurs As PowerPoint.Presentation
Dim PPlaylist As PowerPoint.Presentation
Dim PScenario As PowerPoint.Presentation
Dim PCGV As PowerPoint.Presentation
 
 
Set Ppa = New PowerPoint.Application
Ppa.Visible = True
'ouverture de la présentation d'accueil contenant la macro PPT
Set Pdevis = Ppa.Presentations.Open(Filename:="C:\DEVIS\NewDevis.pptm")
'ouverture de la page de garde du devis
Set PEntete = Ppa.Presentations.Open(Filename:="C:\DEVIS\EnteteDevis.pptx")
'1 - insertion de l'entête du devis :
'=========================================================================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\EnteteDevis.pptx", Pdevis.Slides.Count, 1, -1
'sauvegarde du fichier PPT
Pdevis.SaveAs Filename:="C:\DEVIS\NouveauDevis.pptm"
PEntete.Close
 
 
'2 - insertion du PPT Présentation SDF :
'=========================================================================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\DevisSte.pptx", Pdevis.Slides.Count, 1, -1
'sauvegarde du devis PPT
Pdevis.SaveAs Filename:=ThisWorkbook.Path & "\" & "NouveauDevis.pptm"
 
 
'3 - insertion du récapitulatif des produits par calibre
'=========================================================================================
Set PRecap = Ppa.Presentations.Open(Filename:="C:\DEVIS\RecapProdCal.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\RecapProdCal.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
PRecap.Close
'on l'ajoute à la suite de "NewDevis"
 
 
'4 - insertion du graphique des couleurs du devis
'=========================================================================================
Set PCouleurs = Ppa.Presentations.Open(Filename:="C:\DEVIS\CouleursDevis.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\CouleursDevis.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
PCouleurs.Close
 
'5 - insertion du scénario et playlists en fonction du devis sélectionné
'=========================================================================================
'si on fait un devis "A composer", on zappe les titres Scénario et playlists et on va directement à la suite du programme
 Sheets("feux").Select
        Range("M2").Select
        If Range("M2") = "COMPO" Then
        GoTo suite1
 
 
 
'PROGRAMME SUITE 1 : insertion du devis
'**************************************************************************************
suite1:
 
    'AJOUT DU DEVIS :
    '================
'on ajoute la présentation "devis" après le dernier slide de "ScenarioPlaylist.pptx"
'comme on ne connaît pas le nombre de slides composant les différentes présentations, on utilisera : Pdevis.Slides.Count,
'qui comptera le nbre de slides composant "NouveauDevis.pptm" puis 1 (1er slide de "devis.pptx" à (-1) pour insérer la totalité des
'slides de "devis.pptx
Pdevis.Slides.InsertFromFile "C:\DEVIS\devis.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
    'AJOUT DES AGREMENTS :
    '=====================
'on ouvre la présentation "Agréments.pptx"
Set PAgr = Ppa.Presentations.Open(Filename:="C:\DEVIS\Agrements.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\Agrements.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
PAgr.Close
'on l'ajoute à la suite de "NewDevis"
 
    'AJOUT DES CONDITIONS GENERALES DE VENTE :
    '=========================================
Set PCGV = Ppa.Presentations.Open(Filename:="C:\DEVIS\CGVentes.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\CGVentes.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save 'As Filename:=ThisWorkbook.Path & "\" & "NewDevisFin.pptx"
'on ferme la présentation "CGVentes.pptx"
PCGV.Close
End If
 
'FIN DU PROGRAMME SUITE 1
'**************************************************************************************
 
 
'on ajoute les pages de titres pour scénario + playlists
Set PScenario = Ppa.Presentations.Open(Filename:="C:\DEVIS\ScenarioPlaylist.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\ScenarioPlaylist.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
PScenario.Close
 
'on ajoute la playlist en fonction du n° de devis :
If Range("M2") = "N°1" Or Range("M2") = "1 - CAL" Then
Set PPlaylist = Ppa.Presentations.Open(Filename:="C:\DEVIS\Playlist\Playlist1.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist1.pptx", Pdevis.Slides.Count, 1, -1
 
ElseIf Range("M2") = "N°2" Or Range("M2") = "2 - CAL" Then
Set PPlaylist = Ppa.Presentations.Open(Filename:="C:\DEVIS\Playlist\Playlist2.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist2.pptx", Pdevis.Slides.Count, 1, -1
 
ElseIf Range("M2") = "N°3" Or Range("M2") = "3 - CAL" Then
Set PPlaylist = Ppa.Presentations.Open(Filename:="C:\DEVIS\Playlist\Playlist3.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist3.pptx", Pdevis.Slides.Count, 1, -1
 
ElseIf Range("M2") = "N°4" Or Range("M2") = "4 - CAL" Then
Set PPlaylist = Ppa.Presentations.Open(Filename:="C:\DEVIS\Playlist\Playlist4.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist4.pptx", Pdevis.Slides.Count, 1, -1
 
Pdevis.Save
End If
PPlaylist.Close
 
    'AJOUT DU DEVIS :
    '================
'on ajoute la présentation "devis" après le dernier slide de "ScenarioPlaylist.pptx"
'comme on ne connaît pas le nombre de slides composant les différentes présentations, on utilisera : Pdevis.Slides.Count,
'qui comptera le nbre de slides composant "NouveauDevis.pptm" puis 1 (1er slide de "devis.pptx" à (-1) pour insérer la totalité des
'slides de "devis.pptx
Pdevis.Slides.InsertFromFile "C:\DEVIS\devis.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
    'AJOUT DES AGREMENTS :
    '=====================
'on ouvre la présentation "Agréments.pptx"
Set PAgr = Ppa.Presentations.Open(Filename:="C:\DEVIS\Agrements.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\Agrements.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
PAgr.Close
'on l'ajoute à la suite de "NewDevis"
 
    'AJOUT DES CONDITIONS GENERALES DE VENTE :
    '=========================================
 
Set PCGV = Ppa.Presentations.Open(Filename:="C:\DEVIS\CGVentes.pptx")
Pdevis.Slides.InsertFromFile "C:\DEVIS\CGVentes.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
'on ferme la présentation "CGVentes.pptx"
PCGV.Close
 
 
'************************************************************************************************************************
Pdevis.Application.Activate
 
'lancement dans PPT du message de fin de traitement
Ppa.Run "NouveauDevis.pptm!Message"
 
 
MsgBox "le devis est maintenant terminé vous pouvez le vérifier et l'enregistrer dans C:\DEVIS"
'on garde la présentation "NouveauDevis.pptm" à l'écran pour vérification et impression depuis PPT
End Sub

===============================================================================

Merci pour votre aide

Invité · 23/02/2013, 09h24

Bonjour

N'ayant pas Office 2013, difficile de tester.

Par contre, il serait bien que tu indiques sur quelle ligne se trouve l'erreur.

Philippe

**fidecourt** · 23/02/2013, 13h43

Bonjour

Pour répondre à ta question, l'erreur se produit de façon aléatoire.
Des que PowerPoint est lancé plus d'une fois c'est comme si il fermait un des documents crées sans l'enregistrer alors qu'il y a bien le code de sauvegarde de chaque document et la fermeture du document et de PowerPoint
Lorsque je rouvre PowerPoint après la mise en erreur, je trouve un document en attente de sauvegarde, et c'est cela qui bloque le reste du déroulement de la macro.

Ce qui est bizarre c'est que cela ne se produit pas avec la version 2010

J'espère trouver une solution car cela est très bloquant pour l'utilisateur

D'avance merci pour d'éventuelles pistes de solution

Invité · 23/02/2013, 15h19

OK

Utilise l'instruction DoEvents entre la sauvegarde et la nouvelle création pour voir.

Philippe

**fidecourt** · 25/02/2013, 11h16

je vais tester cela demain, car je n'ai pas l'ordi a dispo avant
je te tiens informé et espère que cela va solutionner mon problème
A+

**fidecourt** · 13/03/2013, 11h10

bonjour et désolée du retard mais je reprends seulement mes activités avec Powerpoint.

après pas mal de tests divers et variés j'ai opté pour la solution suivante qui fonctionne :

lors de la création de chaque présentations à concaténer, je sauvegarde mais ne ferme pas la présentation (ci-dessous code de l'une d'entre elle) :

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Sub Entete()
'
'CREATION DU PPT PAGE DE GARDE DU DEVIS
'==============================================================================
Dim objPPT As POWERPOINT.Application
Dim objPres As POWERPOINT.Presentation
Dim objSld As POWERPOINT.Slide
Dim objShp As POWERPOINT.Shape
Dim ObjShTable As POWERPOINT.Shape
Dim Tablo As Variant
Dim i As Integer
 
Dim AskNewSlide As Boolean, SameTableau As Boolean
 
Tablo = Sheets("devis").Range("R2:T2")
 
'Ouvre PP
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
 
'Ajoute une présentation
 
Set objPres = objPPT.Presentations.Add
objPres.SaveAs "c:\DEVIS\EnteteDevis.pptx"
 
'On charge le modele
objPres.ApplyTemplate "C:\DEVIS\modelesPPT\EnteteDevis.potx"  
'=====
'Pour le 1er tour on initialise AskNewSlide a true, on demande donc un nouveau Slide (le 1er)
AskNewSlide = True
 
For i = 1 To UBound(Tablo) 'On commence a 2 pour sauter les entetes de colonnes
 
 
    'ici on regarde si le nomde tableau est vide
    'S'il est vide => on a toujours le même tableau
    'S'il n'est pas vide, on a un tableau different
 
    If AskNewSlide Then
        AskNewSlide = False
        'On ajoute un nouveau Slide
        Set objSld = objPres.Slides.AddSlide(objPres.Slides.Count + 1, objPres.SlideMaster.CustomLayouts(6))
 
       Set objSld = objSld
        Set ObjShTable = objSld.Shapes.AddTable(3, 1)
 
 
        With ObjShTable.Table
            .Columns(1).Width = 670
            .Rows(1).Height = 150
            .Rows(2).Height = 100
            .Rows(3).Height = 100
 
        'On formate le tableau avec un style vierge
         .ApplyStyle "{2D5ABB26-0587-4C30-8999-92F81FD0307C}", True
 
        With ObjShTable
            .Top = 135
        End With
 
 
       With .Cell(1, 1).Shape.TextFrame.TextRange
            .ParagraphFormat.Alignment = ppAlignCenter
            .Font.Name = "Edwardian Script ITC"
            .Font.Size = 70
            .Text = Tablo(1, 1)
        End With
        With .Cell(2, 1).Shape.TextFrame.TextRange
            .ParagraphFormat.Alignment = ppAlignCenter
            .Font.Name = "calibri"
            .Text = "budget : " & Format(Tablo(1, 2), "# ##0") & " € TTC"
            .Font.Size = 24
        End With
        With .Cell(3, 1).Shape.TextFrame.TextRange
            .ParagraphFormat.Alignment = ppAlignCenter
            .Font.Name = "calibri"
            .Font.Size = 24
            .Text = "spectacle du " & Format(Tablo(1, 3), "dd mmmm yyyy") 'pour avoir la date complète = 14 juillet 2011
        End With
 
 End With
 End If
 Next
objPres.Save
'objPres.Close - avant je fermais, là je laisse la présentation ouverte dans PPT
End Sub

une fois toutes les présentations réalisées avec les données d'Excel, je lance une macro qui ferme PPT et donc toutes les présentations

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub FermerPPT()
'
' FermerPPT Macro
 
Dim Ppt As POWERPOINT.Application
 
Set Ppt = New POWERPOINT.Application
Ppt.Visible = True
 
Ppt.Quit
 
 
End Sub

Après je lance la concaténation de toutes les présentations pour créer le devis complet :

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Sub ConcatenerPresentations()
Dim Ppa As POWERPOINT.Application
Dim Pdevis As POWERPOINT.Presentation
 
 
Set Ppa = New POWERPOINT.Application
Ppa.Visible = True
'ouverture de la présentation d'accueil contenant la macro PPT du message de fin d'exécution
Set Pdevis = Ppa.Presentations.Open(Filename:="C:\DEVIS\NewDevis.pptm")
 
 
 
'1 - insertion de l'entête du devis :
'=========================================================================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\EnteteDevis.pptx", Pdevis.Slides.Count, 1, -1
'sauvegarde du fichier PPT
Pdevis.SaveAs Filename:="C:\DEVIS\NouveauDevis.pptm"
 
 
'2 - insertion du PPT Présentation SDF :
'=========================================================================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\DevisSte.pptx", Pdevis.Slides.Count, 1, -1
'sauvegarde du devis PPT
Pdevis.Save
 
 
'3 - insertion du récapitulatif des produits par calibre
'=========================================================================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\RecapProdCal.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
'on l'ajoute à la suite de "NouveauDevis.pptm"
 
 
'4 - insertion du graphique des couleurs du devis
'=========================================================================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\CouleursDevis.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
'5 - insertion du scénario et playlists en fonction du devis sélectionné
'=========================================================================================
'si on fait un devis "A composer", on zappe les titres Scénario et playlists et on va directement à la suite du programme
 Sheets("feux").Select
        Range("M2").Select
        If Range("M2") = "COMPO" Then
        GoTo suite1
 
 
 
'DEBUT PROGRAMME SUITE 1 :
'**************************************************************************************
suite1:
 
    'AJOUT DU DEVIS :
    '================
'on ajoute la présentation "devis" après le dernier slide de "ScenarioPlaylist.pptx"
'comme on ne connaît pas le nombre de slides composant les différentes présentations, on utilisera : Pdevis.Slides.Count,
'qui comptera le nbre de slides composant "NouveauDevis.pptm" puis 1 (1er slide de "devis.pptx" à (-1) pour insérer la totalité des
'slides de "devis.pptx
Pdevis.Slides.InsertFromFile "C:\DEVIS\devis.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
    'AJOUT DES AGREMENTS :
    '=====================
Pdevis.Slides.InsertFromFile "C:\DEVIS\Agrements.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
    'AJOUT DES CONDITIONS GENERALES DE VENTE :
    '=========================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\CGVentes.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save 'As Filename:=ThisWorkbook.Path & "\" & "NewDevisFin.pptx"
End If
 
'FIN DU PROGRAMME SUITE 1
'**************************************************************************************
 
'on ajoute les pages de titres pour scénario + playlists
Pdevis.Slides.InsertFromFile "C:\DEVIS\ScenarioPlaylist.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
'on ajoute la playlist en fonction du n° de devis :
If Range("M2") = "N°1" Or Range("M2") = "1 - CAL" Then
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist1.pptx", Pdevis.Slides.Count, 1, -1
 
ElseIf Range("M2") = "N°2" Or Range("M2") = "2 - CAL" Then
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist2.pptx", Pdevis.Slides.Count, 1, -1
 
ElseIf Range("M2") = "N°3" Or Range("M2") = "3 - CAL" Then
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist3.pptx", Pdevis.Slides.Count, 1, -1
 
ElseIf Range("M2") = "N°4" Or Range("M2") = "4 - CAL" Then
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist4.pptx", Pdevis.Slides.Count, 1, -1
 
Pdevis.Save
End If
    'AJOUT DU DEVIS :
    '================
'on ajoute la présentation "devis" après le dernier slide de "ScenarioPlaylist.pptx"
'comme on ne connaît pas le nombre de slides composant les différentes présentations, on utilisera : Pdevis.Slides.Count,
'qui comptera le nbre de slides composant "NouveauDevis.pptm" puis 1 (1er slide de "devis.pptx" à (-1) pour insérer la totalité des
'slides de "devis.pptx
Pdevis.Slides.InsertFromFile "C:\DEVIS\devis.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
    'AJOUT DES AGREMENTS :
    '=====================
'on ouvre la présentation "Agréments.pptx"
Pdevis.Slides.InsertFromFile "C:\DEVIS\Agrements.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
    'AJOUT DES CONDITIONS GENERALES DE VENTE :
    '=========================================
 
Pdevis.Slides.InsertFromFile "C:\DEVIS\CGVentes.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save 'As Filename:=ThisWorkbook.Path & "\" & "NewDevisFin.pptx"
 
 
'************************************************************************************************************************
Pdevis.Application.Activate
 
'lancement dans PPT du message de fin de traitement
Ppa.Run "NouveauDevis.pptm!Message"
 
 
MsgBox "le devis est maintenant terminé vous pouvez le vérifier et l'enregistrer dans C:\DEVIS"
'on garde la présentation "NewDevisFin.pptx" à l'écran pour vérification et impression depuis PPT
End Sub

et là tout fonctionne parfaitement sans aucune rupture d'application comme avant.
je ne sais pas si c'est la meilleure méthode, mais cela fonctionne !!!

par contre il me reste un problème pour conserver la mise en forme source des présentations créées.
je poste une autre question sur ce sujet

A+ et merci pour l'intérêt porté à ce sujet

**fidecourt** · 13/03/2013, 11h11

bonjour et désolée du retard mais je reprends seulement mes activités avec Powerpoint.

après pas mal de tests divers et variés j'ai opté pour la solution suivante qui fonctionne :

lors de la création de chaque présentations à concaténer, je sauvegarde mais ne ferme pas la présentation (ci-dessous code de l'une d'entre elle) :

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Sub Entete()
'
'CREATION DU PPT PAGE DE GARDE DU DEVIS
'==============================================================================
Dim objPPT As POWERPOINT.Application
Dim objPres As POWERPOINT.Presentation
Dim objSld As POWERPOINT.Slide
Dim objShp As POWERPOINT.Shape
Dim ObjShTable As POWERPOINT.Shape
Dim Tablo As Variant
Dim i As Integer
 
Dim AskNewSlide As Boolean, SameTableau As Boolean
 
Tablo = Sheets("devis").Range("R2:T2")
 
'Ouvre PP
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
 
'Ajoute une présentation
 
Set objPres = objPPT.Presentations.Add
objPres.SaveAs "c:\DEVIS\EnteteDevis.pptx"
 
'On charge le modele
objPres.ApplyTemplate "C:\DEVIS\modelesPPT\EnteteDevis.potx"  
'=====
'Pour le 1er tour on initialise AskNewSlide a true, on demande donc un nouveau Slide (le 1er)
AskNewSlide = True
 
For i = 1 To UBound(Tablo) 'On commence a 2 pour sauter les entetes de colonnes
 
 
    'ici on regarde si le nomde tableau est vide
    'S'il est vide => on a toujours le même tableau
    'S'il n'est pas vide, on a un tableau different
 
    If AskNewSlide Then
        AskNewSlide = False
        'On ajoute un nouveau Slide
        Set objSld = objPres.Slides.AddSlide(objPres.Slides.Count + 1, objPres.SlideMaster.CustomLayouts(6))
 
       Set objSld = objSld
        Set ObjShTable = objSld.Shapes.AddTable(3, 1)
 
 
        With ObjShTable.Table
            .Columns(1).Width = 670
            .Rows(1).Height = 150
            .Rows(2).Height = 100
            .Rows(3).Height = 100
 
        'On formate le tableau avec un style vierge
         .ApplyStyle "{2D5ABB26-0587-4C30-8999-92F81FD0307C}", True
 
        With ObjShTable
            .Top = 135
        End With
 
 
       With .Cell(1, 1).Shape.TextFrame.TextRange
            .ParagraphFormat.Alignment = ppAlignCenter
            .Font.Name = "Edwardian Script ITC"
            .Font.Size = 70
            .Text = Tablo(1, 1)
        End With
        With .Cell(2, 1).Shape.TextFrame.TextRange
            .ParagraphFormat.Alignment = ppAlignCenter
            .Font.Name = "calibri"
            .Text = "budget : " & Format(Tablo(1, 2), "# ##0") & " € TTC"
            .Font.Size = 24
        End With
        With .Cell(3, 1).Shape.TextFrame.TextRange
            .ParagraphFormat.Alignment = ppAlignCenter
            .Font.Name = "calibri"
            .Font.Size = 24
            .Text = "spectacle du " & Format(Tablo(1, 3), "dd mmmm yyyy") 'pour avoir la date complète = 14 juillet 2011
        End With
 
 End With
 End If
 Next
objPres.Save
'objPres.Close - avant je fermais, là je laisse la présentation ouverte dans PPT
End Sub

une fois toutes les présentations réalisées avec les données d'Excel, je lance une macro qui ferme PPT et donc toutes les présentations

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub FermerPPT()
'
' FermerPPT Macro
 
Dim Ppt As POWERPOINT.Application
 
Set Ppt = New POWERPOINT.Application
Ppt.Visible = True
 
Ppt.Quit
 
 
End Sub

Après je lance la concaténation de toutes les présentations pour créer le devis complet :

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Sub ConcatenerPresentations()
Dim Ppa As POWERPOINT.Application
Dim Pdevis As POWERPOINT.Presentation
 
 
Set Ppa = New POWERPOINT.Application
Ppa.Visible = True
'ouverture de la présentation d'accueil contenant la macro PPT du message de fin d'exécution
Set Pdevis = Ppa.Presentations.Open(Filename:="C:\DEVIS\NewDevis.pptm")
 
 
 
'1 - insertion de l'entête du devis :
'=========================================================================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\EnteteDevis.pptx", Pdevis.Slides.Count, 1, -1
'sauvegarde du fichier PPT
Pdevis.SaveAs Filename:="C:\DEVIS\NouveauDevis.pptm"
 
 
'2 - insertion du PPT Présentation SDF :
'=========================================================================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\DevisSte.pptx", Pdevis.Slides.Count, 1, -1
'sauvegarde du devis PPT
Pdevis.Save
 
 
'3 - insertion du récapitulatif des produits par calibre
'=========================================================================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\RecapProdCal.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
'on l'ajoute à la suite de "NouveauDevis.pptm"
 
 
'4 - insertion du graphique des couleurs du devis
'=========================================================================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\CouleursDevis.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
'5 - insertion du scénario et playlists en fonction du devis sélectionné
'=========================================================================================
'si on fait un devis "A composer", on zappe les titres Scénario et playlists et on va directement à la suite du programme
 Sheets("feux").Select
        Range("M2").Select
        If Range("M2") = "COMPO" Then
        GoTo suite1
 
 
 
'DEBUT PROGRAMME SUITE 1 :
'**************************************************************************************
suite1:
 
    'AJOUT DU DEVIS :
    '================
'on ajoute la présentation "devis" après le dernier slide de "ScenarioPlaylist.pptx"
'comme on ne connaît pas le nombre de slides composant les différentes présentations, on utilisera : Pdevis.Slides.Count,
'qui comptera le nbre de slides composant "NouveauDevis.pptm" puis 1 (1er slide de "devis.pptx" à (-1) pour insérer la totalité des
'slides de "devis.pptx
Pdevis.Slides.InsertFromFile "C:\DEVIS\devis.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
    'AJOUT DES AGREMENTS :
    '=====================
Pdevis.Slides.InsertFromFile "C:\DEVIS\Agrements.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
    'AJOUT DES CONDITIONS GENERALES DE VENTE :
    '=========================================
Pdevis.Slides.InsertFromFile "C:\DEVIS\CGVentes.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save 'As Filename:=ThisWorkbook.Path & "\" & "NewDevisFin.pptx"
End If
 
'FIN DU PROGRAMME SUITE 1
'**************************************************************************************
 
'on ajoute les pages de titres pour scénario + playlists
Pdevis.Slides.InsertFromFile "C:\DEVIS\ScenarioPlaylist.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
'on ajoute la playlist en fonction du n° de devis :
If Range("M2") = "N°1" Or Range("M2") = "1 - CAL" Then
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist1.pptx", Pdevis.Slides.Count, 1, -1
 
ElseIf Range("M2") = "N°2" Or Range("M2") = "2 - CAL" Then
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist2.pptx", Pdevis.Slides.Count, 1, -1
 
ElseIf Range("M2") = "N°3" Or Range("M2") = "3 - CAL" Then
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist3.pptx", Pdevis.Slides.Count, 1, -1
 
ElseIf Range("M2") = "N°4" Or Range("M2") = "4 - CAL" Then
Pdevis.Slides.InsertFromFile "C:\DEVIS\Playlist\Playlist4.pptx", Pdevis.Slides.Count, 1, -1
 
Pdevis.Save
End If
    'AJOUT DU DEVIS :
    '================
'on ajoute la présentation "devis" après le dernier slide de "ScenarioPlaylist.pptx"
'comme on ne connaît pas le nombre de slides composant les différentes présentations, on utilisera : Pdevis.Slides.Count,
'qui comptera le nbre de slides composant "NouveauDevis.pptm" puis 1 (1er slide de "devis.pptx" à (-1) pour insérer la totalité des
'slides de "devis.pptx
Pdevis.Slides.InsertFromFile "C:\DEVIS\devis.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
    'AJOUT DES AGREMENTS :
    '=====================
'on ouvre la présentation "Agréments.pptx"
Pdevis.Slides.InsertFromFile "C:\DEVIS\Agrements.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save
 
    'AJOUT DES CONDITIONS GENERALES DE VENTE :
    '=========================================
 
Pdevis.Slides.InsertFromFile "C:\DEVIS\CGVentes.pptx", Pdevis.Slides.Count, 1, -1
Pdevis.Save 'As Filename:=ThisWorkbook.Path & "\" & "NewDevisFin.pptx"
 
 
'************************************************************************************************************************
Pdevis.Application.Activate
 
'lancement dans PPT du message de fin de traitement
Ppa.Run "NouveauDevis.pptm!Message"
 
 
MsgBox "le devis est maintenant terminé vous pouvez le vérifier et l'enregistrer dans C:\DEVIS"
'on garde la présentation "NewDevisFin.pptx" à l'écran pour vérification et impression depuis PPT
End Sub

et là tout fonctionne parfaitement sans aucune rupture d'application comme avant.
je ne sais pas si c'est la meilleure méthode, mais cela fonctionne !!!

par contre il me reste un problème pour conserver la mise en forme source des présentations créées.
je poste une autre question sur ce sujet

A+ et merci pour l'intérêt porté à ce sujet

Erreur exécution 2147023170 - échec appel de procédure distante - POWERPOINT 2013

Powerpoint

Discussions similaires

Partager

Partager