[XL-2010] Création ppt depuis Excel

Bonjour,

Je souhaite créer un présentation ppt depuis des informations excel.
Pour cela j'ai un morceau de code qui fonctionne plutot bien.
La quantité d'information à mettre sur la slide étant importante, je souhaite créer un module par slide. (code trop long pour le faire fonctionner et difficile à lire / corriger)
Cependant, je n'arrive pas à scinder correctement le code. Dès l'appel du deuxième module, le code ne fonctionne plus.

Merci pour votre aide.
Ci dessous mon 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
 
Sub Creationppt()
 
    'Déclarations des variables
Public oPPTApp As PowerPoint.Application
Public oPPTShape As PowerPoint.Shape
Public oPPTFile As PowerPoint.Presentation
Public slidenum As Integer
Dim Var288 As Variant
Dim oPPTShape2 As PowerPoint.Shape
 
 
Dim DerniereLignesavings As Long
Dim savings As String
Dim i As Integer
 
Dim chemin As String
Dim PresPath As String
'Dim strExcelFilePath As String
Dim strNewPresPath As String
 
Application.ScreenUpdating = False
   'call Creation_date_choice
    'Creation_date_choice.Show
 
 
    'Valeur variable
        Var288 = Sheets("Dashboard").Range("H2")
 
    'Reset valeurs KPI
   Call Reset_KPI_DASHBOARD
   Application.Calculation = xlCalculationAutomatic
   Application.Calculation = xlCalculationManual
 
 
 
 
    'Path source et destination
 
    chemin = ThisWorkbook.Path & "\"
    PresPath = chemin & "PPT_SOURCE.pptx"
    strNewPresPath = chemin & "2019 CW" & Var288 & " - Cross-Functional Shopfloor Review_STEC" & ".pptx"
 
 
    'ouverture de la pres
        Set oPPTApp = CreateObject("PowerPoint.Application")
        oPPTApp.Visible = msoTrue
        Set oPPTFile = oPPTApp.Presentations.Open(PresPath)
 
 
 
    DerniereLignesavings = Sheets("tables").Range("B" & Rows.Count).End(xlUp).Row
 
 
 
Sheets("Dashboard").Range("c9") = "Gross Savings"
                  'Selection slide 1
                    slidenum = 1
                    oPPTFile.Slides(slidenum).Select
 
 
 
 
                    'Date
                    Set oPPTShape = oPPTFile.Slides(slidenum).Shapes("Date")
                    Sheets("Dashboard").Activate
                    With oPPTShape.TextFrame.TextRange
                    .Text = "As of " & Range("F3")
                    End With
 
''Suite de code identique au paragraphe précédent " 'date "
 
 
Call ppt_A4_NET  'c'est ici que je souhaite créer la deuxième slide
 
 
'i = i + 1
 
   Application.Calculation = xlCalculationAutomatic
 
     Application.ScreenUpdating = True
'Next c
 
 
    oPPTFile.SaveAs strNewPresPath
    oPPTFile.Close
    oPPTApp.Quit
 
    Set oPPTShape = Nothing
    Set oPPTFile = Nothing
    Set oPPTApp = Nothing
 
   Application.Calculation = xlCalculationAutomatic
 
 
 
End Sub

Création ppt depuis Excel - 1 module par slide