Bonsoir à tous,

Je reprend un topic que j'ai ouvert dans la section powerpoint - qui n'était peut être pas appropriée car j'ai trouvé un topic traitant d'une problématique proche ici :

mon besoin n'est pas compliqué et j'ai réussi à trouver sur différents topics ce que je recherchais MAIS il me manque juste un petit détail pour finaliser mon projet.

En effet, j'ai un fichier excel avec 2 feuilles.
A coté, j'ai un modèle de powerpoint avec 2 slides, la première est la page de garde - la seconde est "dynamique" et s'alimente via un tableau de l'onglet 2 du fichier excel ("Pige")

Tout fonctionne bien mais j'ai juste besoin d'ajouter à mon code : une partie qui permet d'aller chercher le texte de la cellule B3 de l'onglet 1 ("Bilan") du fichier excel et de la coller sur la slide 1 de mon ppt en titre de la diapositive.

2 questions donc :
- Ou placer cette partie de code dans le code ci-dessous ?
- Quelle est la ligne de code à rajouter ?


Voici mon code :


Code :
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
Sub PPT()
    Dim objPPT As Object
    Dim objPres As Object
    Dim objSld As Object
    Dim objShp As Object
 
    With Sheets("Pige")
        Tablo = Range("A2:B" & Range("A65000").End(xlUp).Row).Value
    End With
 
    Set objPPT = CreateObject("Powerpoint.Application")
    objPPT.Visible = True
 
    Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\template.ppt")
    objPres.SaveAs ThisWorkbook.Path & "\fichierdestination.ppt"
    For i = 1 To UBound(Tablo)
        Set objSld = objPres.Slides(2).Duplicate
        For Each objShp In objSld.Shapes
            If objShp.HasTable Then
                With objShp.Table
                    x = x + 1
                .Cell(2, 1).Shape.TextFrame.TextRange.Text = Tablo(x, 1)
                .Cell(2, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 2)
                End With
            End If
        Next
    Next
    objPres.Slides(2).Delete
    objPres.Save
 
    End Sub
Je pense que la solution n'est pas très compliquée mais j'ai vraiment du mal à comprendre et tous les tests que j'ai fais n'ont pas fonctionné

Merci d'avance de votre aide!