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 : 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
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