[PPT-2010] Titre d'une slide venant d'une cellule excel

[kk8ete]

Bonjour à tous,
Tout d'abord merci pour toutes les ressources et l'aide que vous donnez sur ce forum !
Je vous ai trouvé via une recherche google et j'ai trouvé une mine d'informations..
Moi qui suis débutant, cela m'a permis d'apparendre notamment le VBA powerpoint bien utile

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.

Voici 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
 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!

[Philippe JOCHMANS]

Bonjour

Tu as déjà une partie des éléments dans ton code.

Pour interroger Excel tu peux t'inspirer de cela :

Code :

1
2
3
 With Sheets("Pige")
        Tablo = Range("A2:B" & Range("A65000").End(xlUp).Row).Value
    End With

la seule différence est que ici tu remplis un tableau, alors qu'il te suffit de sélectionner ta cellule, ce qui donnerait quelque chose qui devrait ressembler à cela :

Code :

Sheets("Bilan").Range("B3").Value

Ensuite il te faut mettre cela dans PPT

Le titre (Title) fait partie des formes (Shapes) qui se trouvent sur une diapositive. Voici donc un exemple à adapter, le code suivant écrit Toto dans le titre de la première diapositive.

Code :

1
2
3
4
Dim objSld As Slide
Set objSld = ActivePresentation.Slides(1)
 
objSld.Shapes.Title.TextFrame.TextRange = "toto"

Philippe

[kk8ete]

merci beaucoup Philipppe pour cette explication.
Cependant, n'étant vraiment pas familier aux lignes de code VBA, je ne sais pas vraiment où les placer et il semble qu'en essayant avec ce que tu m'as donné cela ne fonctionne pas malgré plusieurs tests.

je rencontre souvent : "erreur de compilation, utilisateur non défini"

Voici ce que j'ai testé suite à ton message :

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
 
    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 & "\note.ppt")
    objPres.SaveAs ThisWorkbook.Path & "\test.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
 
                 With Sheets("Bilan").Range("B3").Value
 
                Dim objSld As Slide
Set objSld = ActivePresentation.Slides(1)
 
objSld.Shapes.Title.TextFrame.TextRange = "toto"
 
            End If
        Next
    Next
    objPres.Slides(2).Delete
    objPres.Save
 
 
    End Sub

Et un autre test :

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
 
    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 & "\note.ppt")
    objPres.SaveAs ThisWorkbook.Path & "\test.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
 
                 With Sheets("Bilan")
                 .Range("B3").Value
                End With
                Dim objSld As Slide
        Set objSld = ActivePresentation.Slides(1)
        bjSld.Shapes.Title.TextFrame.TextRange = "toto"
 
            End If
        Next
    Next
    objPres.Slides(2).Delete
    objPres.Save
 
 
    End Sub

[Philippe JOCHMANS]

Bonjour

Le code que je t'ai mis était à adapter, tu as fait un copier-coller.

Ici tu n'es pas sur une présentation active, mais sur un pilotage de PowerPoint à partir d'Excel, donc cette ligne ne va pas :

Code :

 Set objSld = ActivePresentation.Slides(1)

Essayes à la place (dans la mesure où c'est la première diapositive)

Code :

 Set objSld = objPres.Slides(1)

De même, je t'ai donné des pistes pour récupérer les informations dans le fichier Excel, et je ne vois rien de cela dans ton code.

Philippe

[kk8ete]

Merci pour ton aide et tes explications

Malheureusement, comme je te l'ai dit, je suis débutant et toutes ces notions sont très abstraites pour moi.
J'ai récupérer un code que j'ai adapté assez facilement pour mon besoin mais je n'ai pas modifié grand chose et j'ai vraiment tatonné.
La logique VBA et toutes les formules liées sont un grand mystère pour moi.

Quand tu me donnes ces conseils, je suis déja bloqué au moment de placer correctement les lignes à adapter dans la structure actuelle (c'est te dire mon niveau ).

Cela dit, j'ai essayé, en regardant le code d'origine de comprendre comment adapter ce que tu m'as donné..

Pour mieux comprendre je vais donc décomposer un peu le code actuel pour voir si je comprend tout bien

Code :

1
2
3
4
5
6
7
8
9
10
 
    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

>> On demande à excel de chercher dans la feuille 'Pige' et on lui dit que "Tablo" est égale à une place de cellule déterminée.

Code :

1
2
3
4
5
  Set objPPT = CreateObject("Powerpoint.Application")
    objPPT.Visible = True
 
    Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\note.ppt")
    objPres.SaveAs ThisWorkbook.Path & "\test.ppt"

>> On lui donne l'instruction d'ouvrir un fichier PPT dont le modèle est note.ppt et de la sauvegarder sous test.ppt

Code :

1
2
3
4
5
6
7
8
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)

>> C'est là que ca se complique.. je ne comprend pas le "For i" :'
Ensuite on lui dit de prendre la slide 2 et de la dupliquer selon les ligne du "Tablo".

--> Pour moi c'est ici que je dois coller la suite du code ??


Maintenant et avant de fermer le code je tente d'ajouter ce que je veux selon les lignes que tu m'as donné.
Du coup je fais :

Code :

1
2
3
With Sheets("Bilan")
                 .Range("B3").Value
                End With

>> On demande à Excel d'aller chercher dans la feuille bilan et de récupérer la valeur de la cellule B3.

Code :

1
2
Dim objSld As Slide
 Set objSld = objPres.Slides(1)

>> On lui demande de sélectionner la slide 1 du ppt.


Et là je ne sais plus quoi faire
Déja que je ne suis pas sur que mon interprétation est bonne.

Dois-je rajouter quelque chose comme ça : ?

Code :

  .Shapes(2).TextFrame.TextRange.Text = Range("B3")

Merci bcp

[kk8ete]

Bonsoir à tous,

Auriez-vous une réponse à ma problématique ?
Je dois utiliser le document demain et ce serait dommage de ne pas pouvoir utiliser cette fonctionnalité qui parait plutôt facile à mettre en place pour les connaisseurs.

Si vous pouvez me donnez la solution ce serait vraiment apprécié et je pourrais comprendre comment le refaire par la suite.

D'avance merci pour votre aide et vos conseils qui ont déja été bien précieux

Merci à vous.

[kk8ete]

Personne ?