bonjour,

j'ai une macro EXCEL 2013 qui concatène plusieurs présentations PPT.

Le problème c'est qu'à partir d'un moment, les présentations PPT ne garde plus leur mise en forme d'origine, bien que sauvegardés

je voudrais mettre le code VBA qui correspond à la fonction POWERPOINT : conserver la mise en forme source lors de l'insertion de présentations via des fichiers déjà existants (ce qui le cas)

comment écrire cela en VBA ?

voici le code de la macro de concaténation de 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
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
une idée sur la question ?
d'avance merci à tous