Bonjour,

J'ai créer un macro sur Excel qui permet :

- d'ouvrir un PowerPoint contenant des macros (pptm)
- mettre des données excel dans des tableaux PowerPoint
- enregistrer le PowerPoint en pptm puis en ppsm (mode diaporama)
- Fermez le pptm
- et enfin : Ouvrir le ppsm

Le problème, c'est que lorsque l'utilisateur arrive à la fin du diapo ppsm, ça quitte bien le mode diaporama mais l'application reste toujours ouverte, et j'aimerai qu'elle se ferme à la fin du mode diaporama

Ci-dessous le code VBA excel :

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
127
128
129
Dim r, c, z, x As Integer
Dim a As Currency
r = 3
c = 1
'Dim objPPT As PowerPoint.Application
Dim shtData As Worksheet, objPPT, objPres As Object, i%, j%, mytable As PowerPoint.Shape, tabindex%
 
Application.ScreenUpdating = False
While r < 40
 
    If Sheets("Interface").Cells(5, 2).Value = Sheets("Data").Cells(r, c).Value Then
 
        'ouvrir powerpoint
            Set shtData = Worksheets("Data")
            Set objPPT = CreateObject("Powerpoint.Application")
            objPPT.Visible = True
            Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\Data\Management visuel OF.pptm")
 
 
        'Cacher toutes les formes
            For x = 1 To objPres.Slides(5).Shapes.Count
                'objPres.Slides(5).Shapes(x).Select
                objPres.Slides(5).Shapes(x).Visible = False
 
            Next x
 
        'Ecrire dans les tableaux
 
        'Composant fini
            If Sheets("Data").Cells(r, c).Value <> "" Then
                objPres.Slides(5).Shapes(1).Visible = True
                objPres.Slides(5).Shapes(17).Visible = True
                objPres.Slides(5).Shapes(18).Visible = True
                With objPres.Slides(5).Shapes(18).Table.Cell(2, 1).Shape.TextFrame.TextRange
                    .Font.Name = "Verdana"
                    .Font.Size = 16
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = shtData.Cells(r, c).Value
                End With
                c = c + 1
                With objPres.Slides(5).Shapes(18).Table.Cell(2, 2).Shape.TextFrame.TextRange
                    .Font.Name = "Verdana"
                    .Font.Size = 16
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = shtData.Cells(r, c).Value
                End With
                With objPres.Slides(5).Shapes(18).Table.Cell(2, 3).Shape.TextFrame.TextRange
                    .Font.Name = "Verdana"
                    .Font.Size = 14
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = shtData.Cells(r, c + 10).Value & " cartons" & " " & shtData.Cells(r, c + 9).Value & " pièces"
                End With
            End If
 
        'Composant 1
            c = c + 1
 
            If Sheets("Data").Cells(r, c).Value <> "" Then
                objPres.Slides(5).Shapes(2).Visible = True
                objPres.Slides(5).Shapes(3).Visible = True
                objPres.Slides(5).Shapes(4).Visible = True
                With objPres.Slides(5).Shapes(2).Table.Cell(2, 1).Shape.TextFrame.TextRange
                    .Font.Name = "Verdana"
                    .Font.Size = 18
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = shtData.Cells(2, c).Value
                End With
                With objPres.Slides(5).Shapes(2).Table.Cell(2, 2).Shape.TextFrame.TextRange
                    .Font.Name = "Verdana"
                    .Font.Size = 18
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = shtData.Cells(r, c).Value
                End With
                With objPres.Slides(5).Shapes(2).Table.Cell(2, 3).Shape.TextFrame.TextRange
                    .Font.Name = "Verdana"
                    .Font.Size = 18
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = shtData.Cells(r, c + 10).Value & " cartons"
                End With
            End If
 
 
        'Composant 2
            c = c + 1
 
            If Sheets("Data").Cells(r, c).Value <> "" Then
                objPres.Slides(5).Shapes(8).Visible = True
                objPres.Slides(5).Shapes(9).Visible = True
                objPres.Slides(5).Shapes(10).Visible = True
                With objPres.Slides(5).Shapes(9).Table.Cell(2, 1).Shape.TextFrame.TextRange
                    .Font.Name = "Verdana"
                    .Font.Size = 18
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = shtData.Cells(2, c).Value
                End With
                With objPres.Slides(5).Shapes(9).Table.Cell(2, 2).Shape.TextFrame.TextRange
                    .Font.Name = "Verdana"
                    .Font.Size = 18
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = shtData.Cells(r, c).Value
                End With
                With objPres.Slides(5).Shapes(9).Table.Cell(2, 3).Shape.TextFrame.TextRange
                    .Font.Name = "Verdana"
                    .Font.Size = 18
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = shtData.Cells(r, c + 10).Value & " cartons"
                End With
            End If
    End If
    r = r + 1
Wend
 
 
With objPres
    .SaveAs Filename:=.Path & "\Management visuel OF.pptm"
    .SaveAs Filename:=ThisWorkbook.Path & "\Management visuel OF.ppsm"
    '.Close
End With
'ferme la présentation
objPres.Close
 
 
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\Management visuel OF.ppsm")
objPres.SlideShowSettings.Run
 
Set objPPT = Nothing
Set objPres = Nothing
Avez-vous des conseil svp ?

Merci d'avance !