Remplir Ppt avec le contenu des cellules d'un classeur

Bonsoir\Bonjour à tous

Je suis actuellement en train d'essayer d'automatiser le passage d'information d'un classeur Excel vers une diapo Powerpoint.

Le soucis est que je suis complètement perdu dans la manipulation des Shapes...

Ce que j'aimerais faire c'est prendre le contenu de certaines cellule dans mon classeur pour remplir des shapes avec.

Par exemple je voudrais que le titre de ma diapo1 devienne le contenu de la cellule B2 ect.

J'ai trouvé ce morceau de code mais je n'arrive pas à l'adapter. Pour l'instant une nouvelle zone de texte est créée et à l"intérieur de celle-ci on peut retrouver le texte de la cellule B2 alors que je ne souhaite pas avoir une nouvelle zone de texte mais juste remplir le titre de la diapo.

Private Sub CommandButton1_Click()

Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim NbShpe As Integer
Set PptApp = CreateObject("Powerpoint.Application")

Dim FichierPpt, pwpt, presppt
Set pwpt = CreateObject("PowerPoint.Application")
pwpt.Visible = True '

Set presppt = PptApp.Presentations.Open(Filename:="D:\Users\Damien\Desktop\Présentation1222.pptx")

pwpt.Visible = True
With presppt
    '--- Ajoute un Slide
   ' .Slides.Add Index:=1, Layout:=ppLayoutBlank
    'Crée une zone de texte (AddLabel)
    Set Sh = .Slides(1).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
        Left:=100, Top:=100, Width:=150, Height:=60)

    'insère la valeur de la Cellule B2 dans une zone de texte
    Sh.TextFrame.TextRange.Text = Range("B2")
    'Modifie la couleur du texte
    Sh.TextFrame.TextRange.Font.Color = RGB(255, 100, 255)

    'Compte le nombre de shapes dans la diapositive:
    'le dernier objet inséré correspond à l'index le plus élevé
    NbShpe = Diapo.Shapes.Count

    End With

End Sub

Merci d'avance à ceux qui auront le temps et la patience de m'aider et à ceux qui m'auront au moins lu!

Bonne soirée à tous.

C'est bon je pense avoir trouvé, merci à ceux qui ont au moins pris le temps de me lire.

Je laisse un morceau de code si ça peut servir!

Private Sub CommandButton1_Click()

    'Déclarations des variables
Dim oPPTApp As PowerPoint.Application
Dim oPPTShape As PowerPoint.Shape
Dim oPPTFile As PowerPoint.Presentation
Dim SlideNum As Integer
Dim Var288 As Variant
Dim oPPTShape2 As PowerPoint.Shape

    'Valeur variable
    Var288 = Range("B2")

    'Path source et destination
    Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
    strPresPath = "D:\Users\Damien\Desktop\Présentation1222.pptx"
    strNewPresPath = "D:\Users\Damien\Desktop\" & Var288 & ".pptx"

    'Titre1
    Set oPPTApp = CreateObject("PowerPoint.Application")
    oPPTApp.Visible = msoTrue
    Set oPPTFile = oPPTApp.Presentations.Open(strPresPath)
    SlideNum = 1
    oPPTFile.Slides(SlideNum).Select
    Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Titre1")

    Sheets("Feuil1").Activate
    With oPPTShape.TextFrame.TextRange
    .Text = Range("B2")

    End With

    'Libellé
    SlideNum = 1
    oPPTFile.Slides(SlideNum).Select
    Set oPPTShape2 = oPPTFile.Slides(SlideNum).Shapes("Libellé")

    Sheets("Feuil1").Activate
    With oPPTShape2.TextFrame.TextRange
    .Text = "Libellé : " & vbNewLine & "" & Range("D5") & ""

    End With

    oPPTFile.SaveAs strNewPresPath
    oPPTFile.Close
    oPPTApp.Quit

    Set oPPTShape = Nothing
    Set oPPTFile = Nothing
    Set oPPTApp = Nothing

    MsgBox "Diapo n° créée ", vbOKOnly + vbInformation
    Unload Me
End Sub