Discussion :

[tiber33]

Bonjour,

J'ai une macro qui créée un fichier powerpoint, y colle des slides d'autres ppt, mais j'aimerai, avant y coller les slides des autres ppt y créer une toute première slide avec un titre, or je n'y arrive pas avec le code suivant:

En gros, j'ai ici mis un extrait d'un code qui tourne, à part quand j'y ajoute la partie "création 1ère slide" (ligne 34 à 42 ), la déclaration ligne 6 est aussi vraisemblablent fausse...

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
Option Explicit
 
    Dim appPPoint As powerpoint.Application
    Dim Presentation, Maitre As powerpoint.Presentation
    Dim diapositive As powerpoint.Slides
    Dim ppLayoutTitle As powerpoint.PpSlideLayout
    Dim derniereslide, pagecount, c, d As Integer
    Dim str, myfile, chemin, chemin_final As String
 
 
 
Sub Créer_présentation()
 
'chemin du répertoire
chemin = Workbooks(ActiveWorkbook.Name).Path
 
str = "Titre_bidon"
 
chemin_final = chemin & "\fichier.pptx"
 
'créer présentation
Set appPPoint = New powerpoint.Application
 
'enregistrer et fermer
With appPPoint.Presentations.Add
    .SaveAs chemin_final
    .Close
End With
 
'ré-ouvrir
Set Maitre = appPPoint.Presentations.Open(chemin_final, withWindow:=msoFalse)
 
 
'création 1ère slide
Set pptSlide = Maitre.Slides.AddSlide(1, ppLayoutTitle)
 
Set diapositive = Maitre.Slides(1)
diapositive.Shapes(1).TextFrame.TextRange = "Titre : " & str
diapositive.Shapes(2).TextFrame.TextRange = "Line 1" & vbNewLine & _
    "Line 2" & vbNewLine & _
    "Line 3" & vbNewLine & _
    "Line 4" & vbNewLine
 
 
'récupérer les presentation aux noms contenus AA2 et compagnie
derniereslide = 1
 
For c = 2 To d
 
    myfile = Sheets("accueil").Cells(c, 27).Value 'récupérer nom
 
    chemin_final = chemin & "\" & myfile
 
    'travail dans powerpoint
    Set Presentation = appPPoint.Presentations.Open(chemin_final, withWindow:=msoFalse)
 
    pagecount = Presentation.Slides.Count
    Maitre.Slides.InsertFromFile chemin & "\" & myfile, derniereslide, 1, pagecount
 
    derniereslide = derniereslide + pagecount
 
    Presentation.Close
 
Next c
 
'enregistrer et fermer
With Maitre
    .Save
    .Close
End With
 
'effacer colonne de travail
Sheets("accueil").Activate
Columns("AA:AA").ClearContents
 
End Sub

j'ai zieuté pas mal de topics sur beaucoup de forums, j'ai essayé d'adapté à ma situation mais je semble être hermétique à la commande de ppt via excel..
Si quelqu'un a une solution concrète pour créer cette première page avec un modèle simple de titre et écrire dans les 2 premières zones de texte je suis preneur.

[Daniel.C]

Bonjour,

Toute ma science s'arrête ici. Adapte le code à tes besoins.

Code :

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

1
2
3
4
5
6
Set ObjPwpt = CreateObject("Powerpoint.Application")
Set ObjPres = ObjPwpt.Presentations.Add
Set ObjPres = ObjPwpt.ActivePresentation
Set Diapo = ObjPres.Slides.Add(1, ppLayoutTitle)
Diapo.Shapes(1).TextFrame.TextRange.Text = "titi"
Diapo.Shapes(2).TextFrame.TextRange.Text = "tutu"

[danixdb]

Bonjour Tiber33, Daniel.C, le Forum

En adaptant ton code, la présentation est créee et le titre est écrit dans une shape.

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
 
Sub Créer_présentation()
  Dim pptApp As PowerPoint.Application, PptDoc As PowerPoint.Presentation, Diapo As PowerPoint.Slide
  Dim derniereslide, pagecount, c, d As Integer
  Dim strPPTFile, strTitle As String, myfile, chemin, chemin_final As String
 
'chemin du répertoire
chemin = Workbooks(ActiveWorkbook.Name).Path
 
strTitle = "Titre_bidon"
 
strPPTFile = chemin & "\fichier.pptx"
 
'créer présentation
Set pptApp = CreateObject("Powerpoint.Application")
 
pptApp.Visible = True
 
'enregistrer et fermer
Set PptDoc = pptApp.Presentations.Add(True)
PptDoc.Slides.Add Index:=1, Layout:=ppLayoutTitle
 
'création 1er slide
PptDoc.Slides(1).Shapes.AddShape msoShapeRectangle, 5, 25, 100, 50
PptDoc.Slides(1).Shapes(1).TextFrame.TextRange = "Titre : " & strTitle
PptDoc.Slides(1).Shapes(2).TextFrame.TextRange = "Line 1" & vbNewLine & _
    "Line 2" & vbNewLine & _
    "Line 3" & vbNewLine & _
    "Line 4" & vbNewLine
 
 
PptDoc.SaveAs strPPTFile
PptDoc.Close
 
 
'effacer colonne de travail
Sheets("accueil").Activate
Columns("AA:AA").ClearContents
 
End Sub

J'ai simplement mis mes noms de variables pour m'y retrouver rapidement et tu peux bien sur les adapter à ta façon.

Slts

[tiber33]

Bonjour Danixdb, Daniel.C et surtout merci

Par fainéantise, j'ai directement pris le code de Danixdb qui de la même architecture que mon code, et ça marche super !
pour les variables à changer, ça devrait aller ..

Je clos le sujet et vous souhaite un bon week-end.