Excel VBA et PPT

Le 17/10/2022 à 15:02

bonjour à tous, il y a quelques temps (plus d'un an) j'avais appelé a l'aide pour une macro qui me permettait a partir d'un fichier excel d'alimenter des slides powerpoint ( a partir d'une slide template).

a chaque ligne ajouté une nouvelle diapositive s'incrementait.

J'ai cru présumer de ma comphréhension de la macro car j'ai voulu l'adapter et j'ai des erreurs.

ci dessous la macro que j'ai entré en module 1 de mon tableau excel

Sub PPTableMacro()

Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
Dim wksht As Worksheet
Dim Dlig As Integer
Dim SlideNom As String

Set wksht = ThisWorkbook.Sheets("Feuil1")
Dlig = wksht.Cells(Rows.Count, 1).End(xlUp).Row

'====>> à ADAPTER le chemin et le nom du fichier

strPresPath = "Y:\Etudes Cliniques\COMMUNICATION - MEDICAL WRITING GROUP\5.COMMUNICATION\7. Publications Commitee\publication stream\PUBLICATION FORMS SUBMISSION.pptx"
strNewPresPath = "Y:\Etudes Cliniques\COMMUNICATION - MEDICAL WRITING GROUP\5.COMMUNICATION\7. Publications Commitee\publication stream"

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

Set oPPTShape1 = oPPTFile.Slides(1).Rectange(21) 'Abstract/Full
Set oPPTShape2 = oPPTFile.Slides(1).Rectangle(22) 'Target (journal, congress)
Set oPPTShape3 = oPPTFile.Slides(1).Rectangle(6) 'Strategic aim
Set oPPTShape4 = oPPTFile.Slides(1).Rectangle(19) 'Key message
Set oPPTShape5 = oPPTFile.Slides(1).Rectangle(15) 'Expected timelines
Set oPPTShape6 = oPPTFile.Slides(1).Rectangle(12) 'Lead
Set oPPTShape7 = oPPTFile.Slides(1).Rectangle(10) 'Author
Set oPPTShape8 = oPPTFile.Slides(1).Rectangle(20) 'Publication Type

With oPPTShape1
.TextFrame.TextRange.Text = Cells(Dlig, 3).Text
End With

With oPPTShape2
.TextFrame.TextRange.Text = Cells(Dlig, 5).Text
End With

With oPPTShape3
.TextFrame.TextRange.Text = Cells(Dlig, 1).Text
End With

With oPPTShape4
.TextFrame.TextRange.Text = Cells(Dlig, 8).Text
End With

With oPPTShape5
.TextFrame.TextRange.Text = Cells(Dlig, 9).Text
End With

With oPPTShape6
.TextFrame.TextRange.Text = Cells(Dlig, 2).Text
End With

With oPPTShape7
.TextFrame.TextRange.Text = Cells(Dlig, 6).Text
End With

With oPPTShape8
.TextFrame.TextRange.Text = Cells(Dlig, 4).Text
End With

oPPTFile.SaveAs strNewPresPath & Cells(Dlig, 7).Text
oPPTFile.Close
oPPTApp.Quit

Set oPPTFile = Nothing
Set oPPTApp = Nothing

End Sub

Je vous joint également le fichier excel dans lequel j'ai mis la macro et le template ppt

en espérant que vous pourriez m'aider tout en m'expliquant où sont mes erreurs pour m'améliorer

7publication-form-submission.pptx (40.55 Ko)
10publications-dashboard2.xlsm (25.26 Ko)

merci d'avance

cordialement

Le 17/10/2022 à 15:54

Bonjour,

Le nom du diaporama affecté à ta variable strPresPath contient un 's' à la fin de "FORMS" (pas le fichier que tu as transmis !? C'est sans doute le fait de charger le fichier sur le Forum qui remplace les espaces par des tirets, mais ça n'explique pas le 's' manquant)

D'autre part je remplacerais les instructions

Set oPPTShape1 = oPPTFile.Slides(1).Rectange(21) 'Abstract/Full

par

Set oPPTShape1 = oPPTFile.Slides(1).Shapes("Rectangle 21")         'Abstract/Full

Vérifie aussi s'il ne devrait pas y avoir un '\' entre strNewPresPath et Cells(Dlig, 7).Text au moment du SaveAs

Le 17/10/2022 à 17:53

bonjour merci pour ta réponse , j'ai tout bien modifié comme indiqué

voici mon code le nom des fichiers est ok (il y a bien un S pour le nom de mon fichier final)

mais en fait je vois mon fichier ppt apparaitre et disparaitre et il n'y pas les données dedans

j'ai essayé également d'ajouter '\' mais il indique un message d'erreur

merci encore pour votre aide

cordialement

Sub PPTableMacro()

Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
Dim wksht As Worksheet
Dim Dlig As Integer
Dim SlideNom As String

Set wksht = ThisWorkbook.Sheets("dashboard")
Dlig = wksht.Cells(Rows.Count, 1).End(xlUp).Row

'====>> à ADAPTER le chemin et le nom du fichier

strPresPath = "Y:\Etudes Cliniques\COMMUNICATION - MEDICAL WRITING GROUP\5.COMMUNICATION\7. Publications Commitee\publication stream\PUBLICATION FORMS SUBMISSION.pptx"
strNewPresPath = "Y:\Etudes Cliniques\COMMUNICATION - MEDICAL WRITING GROUP\5.COMMUNICATION\7. Publications Commitee\publication stream"

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

Set oPPTShape1 = oPPTFile.Slides(1).Shapes("Rectangle 21") 'Abstract/Full
Set oPPTShape2 = oPPTFile.Slides(1).Shapes("Rectangle 22") 'Target (journal, congress)
Set oPPTShape3 = oPPTFile.Slides(1).Shapes("Rectangle 6") 'Strategic aim
Set oPPTShape4 = oPPTFile.Slides(1).Shapes("Rectangle 19") 'Key message
Set oPPTShape5 = oPPTFile.Slides(1).Shapes("Rectangle 15") 'Expected timelines
Set oPPTShape6 = oPPTFile.Slides(1).Shapes("Rectangle 12") 'Lead
Set oPPTShape7 = oPPTFile.Slides(1).Shapes("Rectangle 10") 'Author
Set oPPTShape8 = oPPTFile.Slides(1).Shapes("Rectangle 20") 'Publication Type

With oPPTShape1
.TextFrame.TextRange.Text = Cells(Dlig, 3).Text
End With

With oPPTShape2
.TextFrame.TextRange.Text = Cells(Dlig, 5).Text
End With

With oPPTShape3
.TextFrame.TextRange.Text = Cells(Dlig, 1).Text
End With

With oPPTShape4
.TextFrame.TextRange.Text = Cells(Dlig, 8).Text
End With

With oPPTShape5
.TextFrame.TextRange.Text = Cells(Dlig, 9).Text
End With

With oPPTShape6
.TextFrame.TextRange.Text = Cells(Dlig, 2).Text
End With

With oPPTShape7
.TextFrame.TextRange.Text = Cells(Dlig, 6).Text
End With

With oPPTShape8
.TextFrame.TextRange.Text = Cells(Dlig, 4).Text
End With

oPPTFile.SaveAs strNewPresPath & Cells(Dlig, 7).Text
oPPTFile.Close
oPPTApp.Quit

Set oPPTFile = Nothing
Set oPPTApp = Nothing

End Sub

Edit modo : code mis entre balises

Le 17/10/2022 à 18:21

Bonsoir Stéphanie94

Conformément à la charte du forum, merci de mettre les codes donnés entres balises
avec le bouton prévu à cet effet et que vous devriez connaitre

image

Merci d'y faire attention SVP

Le 17/10/2022 à 19:05

Re-bonjour,
Salut Bruno

@Stéphanie94 :

  • Je ne vois pas où tu as essayé d'ajouter un '\'
  • On est d'accord que si le fichier Excel est vide (en tout cas la Feuil1, qui était la feuille active) les Shapes de ton diaporama ne sauraient rien contenir !? Si c'est dans la feuille Dashboard qu'il faut reprendre les données, il faut le préciser (dans ton message, mais aussi dans le code ... et puis vérifier si la police ne serait pas de couleur blanche)
  • Chez moi, j'ai un fichier .pptx qui s'enregistre en fin d'exécution ... il ne contient qu'une seule dia, puisque rien dans le code ne semble boucler sur les données d'une colonne, ni ajouter d'autres dias (contrairement à ce que tu sembles attendre ?)
Le 18/10/2022 à 10:34

Bonjour à tous,

pour répondre au fait du "/" si je l'ajoute j'ai ce type d'erreur de compilation erreur de syntaxe.

j'ai remouliné et effectivement il manque un code pour que à chaque ligne qui s'ajoute dans le tableau une nouvelle slide se créé c'est ma demande mais j'apprends en même temps. j'ai bien mis dashboard pour lidentifier la feuille mon ppt est bon et l'emplacement aussi

je remet accessoirement le ppt si vous voulez tester

9publication-forms-submission.pptx (228.44 Ko)

je remets ci dessous mon code avec balise ;)

Sub PPTableMacro()

Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
Dim wksht As Worksheet
Dim Dlig As Integer
Dim SlideNom As String

Set wksht = ThisWorkbook.Sheets("dashboard")
Dlig = wksht.Cells(Rows.Count, 1).End(xlUp).Row

'====>> à ADAPTER le chemin et le nom du fichier

strPresPath = "X:\macroppt\PUBLICATION FORMS SUBMISSION.pptx"
strNewPresPath = "X:\macroppt"

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

Set oPPTShape1 = oPPTFile.Slides(1).Shapes("Rectangle 21")  'Abstract/Full
Set oPPTShape2 = oPPTFile.Slides(1).Shapes("Rectangle 22")  'Target (journal, congress)
Set oPPTShape3 = oPPTFile.Slides(1).Shapes("Rectangle 6")  'Strategic aim
Set oPPTShape4 = oPPTFile.Slides(1).Shapes("Rectangle 19")  'Key message
Set oPPTShape5 = oPPTFile.Slides(1).Shapes("Rectangle 15")  'Expected timelines
Set oPPTShape6 = oPPTFile.Slides(1).Shapes("Rectangle 12")  'Lead
Set oPPTShape7 = oPPTFile.Slides(1).Shapes("Rectangle 10")  'Author
Set oPPTShape8 = oPPTFile.Slides(1).Shapes("Rectangle 20")  'Publication Type

With oPPTShape1
.TextFrame.TextRange.Text = Cells(Dlig, 3).Text
End With

With oPPTShape2
.TextFrame.TextRange.Text = Cells(Dlig, 5).Text
End With

With oPPTShape3
.TextFrame.TextRange.Text = Cells(Dlig, 1).Text
End With

With oPPTShape4
.TextFrame.TextRange.Text = Cells(Dlig, 8).Text
End With

With oPPTShape5
.TextFrame.TextRange.Text = Cells(Dlig, 9).Text
End With

With oPPTShape6
.TextFrame.TextRange.Text = Cells(Dlig, 2).Text
End With

With oPPTShape7
.TextFrame.TextRange.Text = Cells(Dlig, 6).Text
End With

With oPPTShape8
.TextFrame.TextRange.Text = Cells(Dlig, 4).Text
End With

oPPTFile.SaveAs\strNewPresPath & Cells(Dlig, 7).Text
oPPTFile.Close
oPPTApp.Quit

Set oPPTFile = Nothing
Set oPPTApp = Nothing

End Sub

si vous pouvez m'aider pour ajouter ce qui manque ou m'expliquer et j'essaierais puis vous renverrais certainement pour ajustements :)

merci d'avance

cordialement

Le 18/10/2022 à 12:28

Bonjour,

Stéphanie94 a écrit :

pour répondre au fait du "/" si je l'ajoute j'ai ce type d'erreur de compilation erreur de syntaxe.

Ah mais je n'ai pas écrit '/' : c'est un '\' que j'ai évoqué ! La rigueur et la précision ne sont pas facultatives (en VBA en particulier).

Dans ta feuille "dashboard", tu as utilisé un Tableau (structuré) qui correspond à un ListObject ... lequel ne devrait pas contenir de lignes vides !
Tant qu'à utiliser ce type d'objet, il faut alors adapter le code : en l'état actuel, la variable DLig vaut sans doute 14 (ce qui n'aidera pas à recopier les valeurs attendues)

j'ai bien mis dashboard pour identifier la feuille

Tu vois une référence à cette feuille dans les instructions comme :

With oPPTShape1
.TextFrame.TextRange.Text = Cells(Dlig, 3).Text
End With

Désolé, mais tu avais raison en disant que tu avais "présumé de ta compréhension de la macro" ... Écrire à ta place un nouveau code ne te rendrait service qu'à très court terme et je manque de temps pour expliquer tout VBA ! (ça irait beaucoup plus vite de compléter ton PowerPoint "à la main")

J'en reste là, en ce qui me concerne !

Rechercher des sujets similaires à "vba ppt"