[VBA] Impossible de copier des slide/modifier une presentation ppt

Je passe par excel, pour automatiser un processus.

Le reste est coder via Uipath, donc aucun pb de ce coté.

Mon pb est le suivant :

Je cherche, avec le code cis dessous, a copier un template ppt, à le copier dans mon output, puis a prendre les information depuis excel et a faire 1 slide par lignes.

Malheureusement, bien qu'il ouvre l'excel selectionné et le ppt, il ne modifie rien

Sub Creation_Slide()
' Copy du  ppt

Dim Path_name As String
Path_name = ThisWorkbook.Path
Complete_File_name = Path_name

Dim SourceFile, DestinationFile
SourceFile = Path_name & "/input/Template_PPT.pptx" ' fichier source
DestinationFile = Path_name & "/Output/PPT/Dash_Catalog_" & Replace(Date, "/", "-") & ".pptx" ' Define target file name.
FileCopy SourceFile, DestinationFile ' Copy source to target.

MsgBox ("Copie terminé")

' Open l'excel de input et le ppt output
Dim wb As Workbook
Dim ws As Worksheet

Dim pptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Template_New As CustomLayout
Dim Template_Old As CustomLayout

Set wb = Workbooks.Open("List_Dash_Current_Month.xlsx")
Set ws = wb.Worksheets("Sheet1")

Set pptApp = New PowerPoint.Application
Set PptDoc = pptApp.Presentations.Open(DestinationFile)
pptApp.Visible = True

' recup des info du classeur

Dim title As String
Dim sectr As String
Dim sline As String
Dim dtsrc As String
Dim sttyp As String
Dim geogr As String
Dim langu As String
Dim platf As String
Dim areas As String
Dim userg As String
Dim picnw As String
Dim newop As String
Dim itera As Integer

itera = 1
With PptDoc
    ' Recuperation des slide "template"

    Set Template_New = PptDoc.Slides(2).CustomLayout
    Set Template_Old = PptDoc.Slides(3).CustomLayout

    ' Mise a jour des valeur contenue dans le classeur
    While Cells(itera, 1).Value = Empty
        title = wb.Cells(itera, 1).Value
        sectr = wb.Cells(itera, 2).Value
        sline = wb.Cells(itera, 3).Value
        dtsrc = wb.Cells(itera, 4).Value
        sttyp = wb.Cells(itera, 5).Value
        geogr = wb.Cells(itera, 6).Value
        langu = wb.Cells(itera, 7).Value
        platf = wb.Cells(itera, 8).Value
        areas = wb.Cells(itera, 9).Value
        userg = wb.Cells(itera, 10).Value
        picnw = wb.Cells(itera, 11).Value
        newop = wb.Cells(itera, 12).Value

    ' creation de la copy de la slide template
        itera = itera + 1

        Newslide = PptDoc.Slides.AddSlide(2, Template_New)

    Wend

End With

PptDoc.SaveAs Filename:=DestinationFile
'ferme la presentation
PptDoc.Close
'ferme powerpoint
pptApp.Quit

MsgBox ("Traitement terminé")