Piloter POWERPOINT depuis Excel - utilisation d'un modèle

Version imprimable

Bonjour le forum !

j'ai maintenant une super macro qui génère un diaporama PPT depuis Excel
insère les données et les images
Il me reste maintenant 2 problèmes à résoudre dont voici le premier :

j'ai créé dans PPT un modèle que j'ai nommé "devis.potx" puisqu'il sera utilisé pour générer le devis réalisé dans Excel
le chemin du fichier est c:\devis\devis.potx

mon problème c'est de mettre dans VBAExcel la bonne syntaxe au bon endroit pour que la présentation créée utilise ce modèle
je ne sais où placer ce code et comment le syntaxer correctement
je suppose que c'est à cet endroit que je dois faire quelque chose :

Set CustLayout = objPres.SlideMaster.CustomLayouts.Add(1)

Quelqu'un pourrait il m'aider sur ce point précis ?

voici le code de la macro Excel qui génère le PPT (grand merci à Qwazerty pour son aide dans la création de ce code)

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
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
Option Explicit 'T'oblige a declarer toutes les variables que tu utilises
'Forum DEVELOPPEZ.COM - Auteur : Qwazerty
Sub Devis()
'Active dans les references (menu option) la ligne "Microsoft PowerPoint x.x Object Library"
 
Dim objPPT As PowerPoint.Application
Dim objPres As PowerPoint.Presentation
Dim objSld As PowerPoint.Slide
Dim ObjShTable As PowerPoint.Shape
Dim Tablo As Variant
Dim x As Integer, i As Integer
Dim CustLayout As PowerPoint.CustomLayout
Dim TheRow As Variant
Dim NomTableau As String
Dim NewTop As Integer
Dim TheShTab As PowerPoint.Shape
Dim TmpTop As Integer
Dim objSldImg As Object
Dim objSldImgTable As Object
Dim ObjShImgTable As Object
 
With Sheets("description-prod") 'Il faut presiser le "." dans la suite du code pour y faire reference
    Tablo = .Range("A2:Z" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
 
 
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
 
Set objPres = objPPT.Presentations.Add
 
objPres.SaveAs ThisWorkbook.Path & "\test3.ppt"
 
Set CustLayout = objPres.SlideMaster.CustomLayouts.Add(1) '
 
For i = 1 To UBound(Tablo)
    'On regarde si on doit créer un nouveau Slide ou completer l'existant
    If NomTableau <> Tablo(i, 2) Then
        'On garde en memoire le nom du tableau
        NomTableau = Tablo(i, 2)
 
        'On ajoute un nouveau Slide pour insérer les données
        Set objSld = objPres.Slides.AddSlide(objPres.Slides.Count + 1, Layout:=ppLayoutBlank)
 
        'On renseigne le titre du slide
        objSld.Shapes.Title.TextFrame.TextRange.Text = Tablo(i, 2)
 
        'On ajoute un nouveau slide pour insérer l'image
        Set objSldImg = objPres.Slides.AddSlide(objPres.Slides.Count + 1, CustLayout)
 
        'on crée un tableau d'une seule cellule pour recevoir l'image
        Set ObjShImgTable = objSldImg.Shapes.AddTable(1, 1)
        'on dimensionne la cellule pour l'image
        With ObjShImgTable.Table
        .Columns(1).Width = 500
        .Rows(1).Height = 350
        .Cell(1, 1).Shape.Fill.UserPicture (Tablo(i, 19)) 'insertion de l'image correspondante
         End With
 
    End If
 
    'On crée le tableau qui contiendra les données avec 2 ligne 3 colonnes ou 1 ligne 3 colonnes
    If Tablo(i, 12) <> "" Then
        Set ObjShTable = objSld.Shapes.AddTable(2, 3)
    Else 'Si pas de sous element precisé
        Set ObjShTable = objSld.Shapes.AddTable(1, 3)
    End If
 
    'On regarde si des objet tableau existe et on le rajoute a la suite du plus bas
    NewTop = ObjShTable.Top
    For Each TheShTab In objSld.Shapes
        If TheShTab.HasTable And (TheShTab.Name <> ObjShTable.Name) Then
            TmpTop = TheShTab.Top + TheShTab.Height
            If NewTop < TmpTop Then NewTop = TmpTop + 3
        End If
    Next
    ObjShTable.Top = NewTop
 
    'On dimensionne la taille des colonnes (a toi de voir)
    With ObjShTable.Table
        .Columns(1).Width = 40
        .Columns(2).Width = 40
        .Columns(3).Width = 480
 
 
        'On Rajoute les données article
        'On fusionne les 2 dernieres cellules de a ligne 1
        .Cell(1, 2).Merge .Cell(1, 3)
        'On place l'item principal
        .Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(i, 6) 'Qte
        .Cell(1, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 7) 'Description
        'On place le sous-ensemble uniquement s'il existe
        If Tablo(i, 12) <> "" Then
            .Cell(2, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 11) 'Qte
            .Cell(2, 3).Shape.TextFrame.TextRange.Text = Tablo(i, 12) 'Description
        End If
    End With
Next
 
 
objPres.save
objPres.Close
 
End Sub

d'avance merci

Code:

1
2
Set objPres = objPPT.Presentations.Add
objPres.ApplyTemplate "c:\devis\devis.potx"

29/01/2011, 19h23
fidecourt

j'ai une erreur lors de

Code:

Set objSld = objPres.Slides.AddSlide(objPres.Slides.Count + 1, CustLayout)

erreur : Bad Return Argument
Slides.AddSlide

je suppose qu'il faut changer quelque chose mais quoi ?
d'avance merci

Salut
Alors au vu de ce que donne Mercatog, j'ai découvert ceci.
Dans ton potx, tu as 10 CustomLayout (accessible dans powerpoint via le menu Affichage -> Masque des Diapositives)
Les 2 Layouts qui nous intéresse sont le 6 pour les tableaux et le 7 pour les images)
Donc lors des ajouts il faut préciser l'un ou l'autre

Voila ce que ça donne.
Il va falloir modifier ton Potx pour mettre les cadres en violet et arrondi directement sur les SlideMaster

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
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
Option Explicit 'T'oblige a declarer toutes les variables que tu utilises
'Forum DEVELOPPEZ.COM - Auteur : Qwazerty
Sub BoucleTest2Conditions()
'Active dans les references (menu option) la ligne "Microsoft PowerPoint x.x Object Library"
 
Dim objPPT As POWERPOINT.Application
Dim objPres As POWERPOINT.Presentation
Dim objSld As POWERPOINT.Slide
Dim objSldImg As POWERPOINT.Slide 'Object
Dim ObjShTable As POWERPOINT.Shape
Dim Tablo As Variant
Dim x As Integer, i As Integer
'Dim CustLayout As POWERPOINT.CustomLayout
Dim TheRow As POWERPOINT.Row
Dim NomTableau As String
Dim NewTop As Integer
Dim TheShTab As POWERPOINT.Shape
'Dim objSldImgTable As POWERPOINT.Slide 'Object
Dim ObjShImgTable As POWERPOINT.Shape ' Object
Dim TmpTop As Integer
 
 
With Sheets("description-prod") 'Il faut presiser le "." dans la suite du code pour y faire reference
    Tablo = .Range("A2:Z" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
 
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
 
'Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\note2.pptm")
 
Set objPres = objPPT.Presentations.Add
objPres.SaveAs ThisWorkbook.Path & "\test3.ppt"
 
'On charge le modele
objPres.ApplyTemplate ThisWorkbook.Path & "\DEVIS-PPT.potx"
 
 
'Set CustLayout = objPres.SlideMaster.CustomLayouts.Add(1)
'Si tu veux changer les couleur sur ous tes Slide, il faut modifier CustLayout
'Ca affectera directement la présentation des slides
For i = 1 To UBound(Tablo)
    'On regarde si on doit créer un nouveau Slide ou completer l'existant
    If NomTableau <> Tablo(i, 2) Then
        'On garde en memoire le nom du tableau
        NomTableau = Tablo(i, 2)
 
        'On ajoute un nouveau Slide
        Set objSld = objPres.Slides.AddSlide(objPres.Slides.Count + 1, objPres.SlideMaster.CustomLayouts(6))
 
        'On renseigne le titre du slide
        objSld.Shapes.Title.TextFrame.TextRange.Text = Tablo(i, 2)
 
        'On ajoute un nouveau slide pour insérer l'image
        Set objSldImg = objPres.Slides.AddSlide(objPres.Slides.Count + 1, objPres.SlideMaster.CustomLayouts(7))
        'objSldImg.CustomLayout = ImgLayout
 
        'on crée un tableau d'une seule cellule pour recevoir l'image
        Set ObjShImgTable = objSldImg.Shapes.AddTable(1, 1)
 
        'on dimensionne la cellule pour l'image
        With ObjShImgTable.Table
            .Columns(1).Width = 500
            .Rows(1).Height = 350
'           .Cell(1, 1).Shape.Fill.UserPicture Tablo(i, 7) 'insertion de l'image correspondante 'Ne fonctionne pas chez moi la valeur de Tablo est vide
         End With
 
 
    End If
 
    'On crée le tableau qui contiendra les données avec 2 ligne 3 colonnes ou 1 ligne 3 colonnes
    If Tablo(i, 6) <> "" Then
        Set ObjShTable = objSld.Shapes.AddTable(2, 3)
    Else 'Si pas de sous element precisé
        Set ObjShTable = objSld.Shapes.AddTable(1, 3)
    End If
 
    'On regarde si des objet tableau existe et on le rajoute a la suite du plus bas
    NewTop = ObjShTable.Top
    For Each TheShTab In objSld.Shapes
        If TheShTab.HasTable And (TheShTab.Name <> ObjShTable.Name) Then
            TmpTop = TheShTab.Top + TheShTab.Height
            If NewTop < TmpTop Then NewTop = TmpTop + 3
        End If
    Next
    ObjShTable.Top = NewTop
 
    'On dimensionne la taille des colonnes (a toi de voir)
    With ObjShTable.Table
        .Columns(1).Width = 40
        .Columns(2).Width = 40
        .Columns(3).Width = 480
 
        'On Rajoute les données article
        'On fusionne les 2 dernieres cellules de a ligne 1
        .Cell(1, 2).Merge .Cell(1, 3)
        'On place l'item principal
        .Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(i, 3) 'Qte
        .Cell(1, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 4) 'Description
        'On place le sous-essemble uniquement s'il existe
        If Tablo(i, 6) <> "" Then
            .Cell(2, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 5) 'Qte
            .Cell(2, 3).Shape.TextFrame.TextRange.Text = Tablo(i, 6) 'Description
        End If
    End With
Next
 
objPres.Save
objPres.Close
 
End Sub

++
Qwaz

29/01/2011, 20h04
fidecourt

tu es trop fort !
je fais le nécessaire,
ce sera un point de fait en plus
merci
A+

encore une question !

j'ai modifié le DEVIS-PPT.potx en insérant le logo et en mettant un encadré
Mais
lorsqu'on lance la macro, ou que l'on insère un tableau directement dans PPT
on a un tableau plein de couleur bleue
Ou et comment puis je changer les propriétés pour avoir lors du lancement de la macro un tableau totalement transparent, sans bordures ?
je suppose qu'il faut mettre du code dans Excel puisque le tableau est généré par excel et non dans PPT ,
Une idée ??
A+

Re

Alors

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
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
Option Explicit 'T'oblige a declarer toutes les variables que tu utilises
'Forum DEVELOPPEZ.COM - Auteur : Qwazerty
Sub BoucleTest2Conditions()
'Active dans les references (menu option) la ligne "Microsoft PowerPoint x.x Object Library"
 
Dim objPPT As powerpoint.Application
Dim objPres As powerpoint.Presentation
Dim objSld As powerpoint.Slide
Dim objSldImg As powerpoint.Slide 'Object
Dim ObjShTable As powerpoint.Shape
Dim Tablo As Variant
Dim x As Integer, i As Integer
'Dim CustLayout As POWERPOINT.CustomLayout
Dim TheRow As powerpoint.Row
Dim NomTableau As String
Dim NewTop As Integer
Dim TheShTab As powerpoint.Shape
'Dim objSldImgTable As POWERPOINT.Slide 'Object
Dim ObjShImgTable As powerpoint.Shape ' Object
Dim TmpTop As Integer
 
 
With Sheets("description-prod") 'Il faut presiser le "." dans la suite du code pour y faire reference
    Tablo = .Range("A2:Z" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
 
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
 
'Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\note2.pptm")
 
Set objPres = objPPT.Presentations.Add
objPres.SaveAs ThisWorkbook.Path & "\test3.ppt"
 
'On charge le modele
objPres.ApplyTemplate ThisWorkbook.Path & "\DEVIS-PPT.potx"
 
 
'Si tu veux changer les couleur sur ous tes Slide, il faut modifier CustLayout
'Ca affectera directement la présentation des slides
For i = 1 To UBound(Tablo)
    'On regarde si on doit créer un nouveau Slide ou completer l'existant
    If NomTableau <> Tablo(i, 2) Then
        'On garde en memoire le nom du tableau
        NomTableau = Tablo(i, 2)
 
        'On ajoute un nouveau Slide
        Set objSld = objPres.Slides.AddSlide(objPres.Slides.Count + 1, objPres.SlideMaster.CustomLayouts(6))
 
        'On renseigne le titre du slide
        objSld.Shapes.Title.TextFrame.TextRange.Text = Tablo(i, 2)
 
        'On ajoute un nouveau slide pour insérer l'image
        Set objSldImg = objPres.Slides.AddSlide(objPres.Slides.Count + 1, objPres.SlideMaster.CustomLayouts(7))
 
        'on crée un tableau d'une seule cellule pour recevoir l'image
        Set ObjShImgTable = objSldImg.Shapes.AddTable(1, 1)
        'On format le tableau avec un style vierge
        ObjShImgTable.Table.ApplyStyle "{2D5ABB26-0587-4C30-8999-92F81FD0307C}", True
 
        'ObjShImgTable.Table.Style
        'on dimensionne la cellule pour l'image
        With ObjShImgTable.Table
            .Columns(1).Width = 500
            .Rows(1).Height = 350
'           .Cell(1, 1).Shape.Fill.UserPicture Tablo(i, 7) 'insertion de l'image correspondante 'Ne fonctionne pas chez moi la valeur de Tablo est vide
         End With
 
 
    End If
 
    'On crée le tableau qui contiendra les données avec 2 ligne 3 colonnes ou 1 ligne 3 colonnes
    If Tablo(i, 6) <> "" Then
        Set ObjShTable = objSld.Shapes.AddTable(2, 3)
    Else 'Si pas de sous element precisé
        Set ObjShTable = objSld.Shapes.AddTable(1, 3)
    End If
    'On format le tableau avec un style vierge
    ObjShTable.Table.ApplyStyle "{2D5ABB26-0587-4C30-8999-92F81FD0307C}", True
 
    'On regarde si des objet tableau existe et on le rajoute a la suite du plus bas
    NewTop = ObjShTable.Top
    For Each TheShTab In objSld.Shapes
        If TheShTab.HasTable And (TheShTab.Name <> ObjShTable.Name) Then
            TmpTop = TheShTab.Top + TheShTab.Height
            If NewTop < TmpTop Then NewTop = TmpTop + 3
        End If
    Next
    ObjShTable.Top = NewTop
 
    'On dimensionne la taille des colonnes (a toi de voir)
    With ObjShTable.Table
        .Columns(1).Width = 40
        .Columns(2).Width = 40
        .Columns(3).Width = 400
 
        'On Rajoute les données article
        'On fusionne les 2 dernieres cellules de a ligne 1
        .Cell(1, 2).Merge .Cell(1, 3)
        'On place l'item principal
        .Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(i, 3) 'Qte
        .Cell(1, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 4) 'Description
        'On place le sous-essemble uniquement s'il existe
        If Tablo(i, 6) <> "" Then
            .Cell(2, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 5) 'Qte
            .Cell(2, 3).Shape.TextFrame.TextRange.Text = Tablo(i, 6) 'Description
        End If
    End With
Next
 
objPres.Save
objPres.Close
 
End Sub

Pour connaitre l'ID du style, voila la manip.

Tu mets un point d'arrêt dans ton code sur la ligne (utilisation touche F9)

Code:

ObjShTable.Table.ApplyStyle "{2D5ABB26-0587-4C30-8999-92F81FD0307C}", True

Tu lances la macro, quand le code va arriver sur la ligne en question il va stopper.
Tu sélectionnes la variable ObjShTable (tu double-cliques dessus), puis click droit -> Ajouter un Espions..., tu valides la fenêtre qui s'ouvre.
maintenant tu as une zone de liste nommé Espions qui est ouverte, dedans tu vois ta variable ObjShTable, tu ouvres son arborescence (petit plus comme dans l'explorateur windows(poste de travail))
Tu cherche l'objet Table dans la liste, tu ouvres Table et dans Table tu cherches Style, que tu ouvres et la tu trouve ID et dans la colonne suivante, tu peux voir le numéro de style de ton tableau.

Maintenant tu vas dans PowerPoint, tu modifies ton style de tableau. Pour faire ca, tu sélectionnes le tableau que l'on est en train de créer avec le code, logiquement il se trouve sur le 1er Slide. Dans le bandeau tu vas sur Outils de tableau -> Création et tu modifies ton style dans le groupe Styles de Tableau

Ensuite tu reviens dans vba, juste ou ton code est stoppé, tu as une petite flèche jaune, a l'aide de ta souris tu déplaces cette flèche une ligne avant, de sorte qu'elle pointe la ligne

Code:

End If

qui se trouve immédiatement au dessus.
Si tu regardes de nouveau dans Espions, tu as la nouvelle valeur de l'ID correspondant a ton style de tableau.
Tu peux faire un copier de la ligne ID dans Espions pour utiliser cet ID en lieu et place de celui indiqué dans

Code:

ObjShTable.Table.ApplyStyle "{2D5ABB26-0587-4C30-8999-92F81FD0307C}", True

Ok c'est pas simple, mais je ne vois pas d'autre solution, enfin si plusieurs, mais toutes aussi compliquées ^^.

++
Qwaz

c'est bon pour le tableau, tes explications sont très claires, en effet, cela fonctionne très bien
j'ai rajouté dans le code la postion du tableau, et cela marche
par contre je me heurte maintenant à la question suivante :
pour la Cell(1,1);Cell(2,1) et Cell(2,2)
qui reçoivent en données des nombre, je veux un alignement de ces cellules à droite, et là je n'arrive pas à mettre le code adéquat
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 'On crée le tableau qui contiendra les données avec 2 ligne 3 colonnes ou 1 ligne 3 colonnes If Tablo(i, 12) <> "" Then Set ObjShTable = objSld.Shapes.AddTable(2, 3) With ObjShTable .Left = 50 .Top = 150 End With 'j'ai testé ce qui suit mais ce n'est pas bon 'With ObjShTable.Cell(2, 1) '.HorizontalAlignment = xlRight 'End With 'With Cell(2, 2) '.HorizontalAlignment = xlRight 'End With
Une idée ?
A+

30/01/2011, 23h26
Qwazerty
Salut
Si tu regardes dans l'explorateur d’objets, tu verras vite que la propriétés que tu essais d'utilisé n'existe pas dans l'objet Cell
Pour faire ce que tu souhaites il faut aller plus loin

Code:

.Cell(1, 1).Shape.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft

Les valeur possible sont (normalement elles s'affichent lorsque tu tapes le '=')
- ppAlignCenter
- ppAlignDistribute
- ppAlignJustify
- ppAlignJustifyLow
- ppAlignLeft
- ppAlignmentMixed
- ppAlignRight
- ppAlignThaiDistribute
++
Qwaz
31/01/2011, 12h22
fidecourt

super !
merci (une fois de +)

il me reste un problème à résoudre et apparemment cela n'inspire pas
c'est la création auto de slides quand on arrive en fin de page du premier
j'ai ouvert une discussion là-dessus mais aucune réponse ?
pourrais-tu y jeter un coup d'oeil à l'occasion ?

titre de la question
Piloter POWERPOINT depuis Excel - Ajouter un nouveau slide après la 12ème ligne
date 29 janvier

A+