[PPT-2010] Récupérer le code VBA d'un modèle pour incorporer dans Excel [Résolu]

[fidecourt]

bonjour à tous !

j'ai un fichier excel qui génère un powerpoint avec 2 slides au modèle différent :
j'utilise :
le thème : Horizon
disposition : titre seul
le logo en haut et à gauche

1er modèle de slide :
depuis Excel je crée un tableau de données (qui n'a jamais le même nombre de lignes)
je veux :

• le centrer verticalement
• l'encadrer avec un cadre aux angles arrondis et de couleur mauve

2ème modèle de slide :
depuis Excel je crée pour chaque slide (1), un slide (2) avec l'image correspondant aux données du slide(1)
présentation :
image pleine page sans encadrement

j'ai créé un modèle dans PPT : DEVIS.potx
mais je voudrais récupérer le code VBA pour l'insérer dans la macro Excel
dont voici le 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
Option Explicit 'T'oblige a declarer toutes les variables que tu utilises
'Forum DEVELOPPEZ.COM - Auteur : Qwazerty
Sub POWERPOINT()
'Active dans les references (menu option) la ligne "Microsoft PowerPoint x.x Object Library"
 
Dim objPPT As Object 'POWERPOINT.Application
Dim objPres As Object 'POWERPOINT.Presentation
Dim objSld As Object 'POWERPOINT.Slide
Dim ObjShTable As Object 'POWERPOINT.Shape
Dim Tablo As Variant
Dim x As Integer, i As Integer
Dim CustLayout As Object 'POWERPOINT.CustomLayout
Dim TheRow As Variant 'POWERPOINT.Row
Dim NomTableau As String
Dim NewTop As Integer
Dim TheShTab As Object '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)
'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 pour insérer les données
        Set objSld = objPres.Slides.AddSlide(objPres.Slides.Count + 1, CustLayout)
 
        '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

cela fonctionne très bien, reste le problème du modèle à résoudre...

votre aide sera la bienvenue
d'avance merci aux experts POWERPOINT VBA

[fidecourt]

pour ceux que cela intéresse
reportez vous à cette discussion dans le forum Excel VBA EXCEL

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

Vous y trouverez toutes les réponses documentées par Qwazerty