Transfert de cellules Excel à des shapes Powerpoint

Bonjour tout le monde,

J'ai un problème d'assemblage dans ma macro qui consiste à remplir des zones de texte Powerpoint depuis des cellules dans un fichier Excel.

J'ai au préalable réussi une première version grâce à ces deux liens :
https://excel.developpez.com/faq/?page=Powerpoint
https://www.developpez.net/forums/d2...er-powerpoint/

Mais cela oblige à renseigner le lien du Powerpoint dans la macro (ou dans une cellule Excel).

J'ai voulu modifier la macro en ajoutant la possibilité de parcourir l'ordinateur pour sélectionner un modèle via un Application.GetOpenFilename mais c'est incompatible avec la première macro.

Ce sont les . en face des Slides(4).Shapes, sur l'aide Microsoft cela dit que je dois laisser les Set actifs mais c'est incompatible avec Application.GetOpenFilename.

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

Sub ModifierPresentationExistante()   Dim PptApp As PowerPoint.Application Dim PptDoc As PowerPoint.Presentation Dim Nom As Variant   NomClient = Range("NomClient").Value   Application.GetOpenFilename   'Set PptApp = CreateObject("Powerpoint.Application") 'PptApp.Visible = True 'Set PptDoc = PptApp.Presentations.Open("\Bureau\Modèles\Test - Powerpoint.pptx")   With PptDoc   ActivePresentation.Slides(4).Shapes(2).TextFrame.TextRange.Text = "Here is some test text"   .Slides(4).Shapes(2).TextFrame.TextRange.Text = Range("A3") .Slides(4).Shapes(7).TextFrame.TextRange.Text = Range("A4") .Slides(4).Shapes(8).TextFrame.TextRange.Text = Range("A5") .Slides(4).Shapes(13).TextFrame.TextRange.Text = Range("A6") .Slides(4).Shapes(12).TextFrame.TextRange.Text = Range("A7") .Slides(4).Shapes(15).TextFrame.TextRange.Text = Range("A8")   .Slides(6).Shapes(5).TextFrame.TextRange.Text = Range("A13")   PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & Nom & ".pptx"   End With   PptDoc.Close PptApp.Quit   End Sub

---

Et j'ai essayé une méthode sur Internet pour détecter le numéro de Shapes mais ça ne fonctionne pas, je suis obligé de les deviner en faisant défiler les numéros jusqu'à trouver. Par exemple pour la Shapes (15), il a fallu que je regarde si c'était les 14 premières ce qui est un peu laborieux.

Merci d'avance pour votre aide. Je sais que je suis proche de réussir mais je n'ai trouvé personne sur internet qui avait le même souci que moi.

Citation:

---

Envoyé par Onion

J'ai voulu modifier la macro en ajoutant la possibilité de parcourir l'ordinateur pour sélectionner un modèle via un Application.GetOpenFilename mais c'est incompatible avec la première macro.

Code:

---

Application.GetOpenFilename

---

---

Comme son nom l'indique, la méthode GetOpenFilename a pour seule action de récupérer le nom d'un fichier.
Elle n'ouvre pas d'elle-même le fichier sélectionné.
Lire ceci : https://docs.microsoft.com/fr-fr/off...etopenfilename

Elle n'a donc quasiment aucun intérêt utilisée seule.
Pour utiliser son action, il faut généralement placer dans une variable la valeur qu'elle renvoie.

Code:

---

1 2 3 4 5 6

Dim MonFichier As String Dim PptDoc As PowerPoint.Presentation   MonFichier = Application.GetOpenFilename Set PptDoc = GetObject(MonFichier) PptDoc.Application.Visible = True

---

Merci beaucoup ! Je n'aurais pas trouvé tout seul.

Il n'y a que le PptApp.Quit qui ne se lance pas car non déclaré et quand je le déclare ça ne fonctionne pas.

Donc j'ai enlevé cette lignes de code et je ferme Powerpoint manuellement donc ça va.

Merci.

Citation:

---

Envoyé par Onion

Il n'y a que le PptApp.Quit qui ne se lance pas car non déclaré et quand je le déclare ça ne fonctionne pas.

---

Regarde la dernière ligne de mon code. Elle permet de comprendre comment accéder à l'application d'un objet.