VBA - Comment lancer une Function ?

[Arnaud81]

Bonjour à tous,

j'ai récupéré cette macro, mais je ne sais pas comment lancer une Function...

Le reste est à priori bien paramétré... Et j'ai ajouté la référence Microsoft PowerPoint


'Public Function GenererPPT() As PowerPoint.Presentation
Public Function GenererPPT() As Object
Dim pathPPT As String, tabVarTxt As ListObject, tabVarArea As ListObject, rowVar As ListRow, nbShapes As Long, iShape As Long
'Dim pptApp As PowerPoint.Application, pptPres As PowerPoint.Presentation, pptSlide As PowerPoint.Slide, pptShape As PowerPoint.Shape
Dim pptApp As Object, pptPres As Object, pptSlide As Object, pptShape As Object
Dim fso As Object

'récupérer le tableau de variables
Set tabVarTxt = Me.ListObjects("Tab_Vars_Txt")
Set tabVarArea = Me.ListObjects("Tab_Vars_Zones")

'créer une nouvelle présentation à partir du modèle
pathPPT = Me.Range("PathModelePPT").Text
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(pathPPT) Then Stop 'si arrêt ici, le modèle ppt défini sur la feuille excel n'a pas été trouvé

On Error Resume Next
Set pptApp = GetObject(, "PowerPoint.Application")
If pptApp Is Nothing Then Set pptApp = CreateObject("PowerPoint.Application")
If pptApp Is Nothing Then Stop 'si arrêt ici, on n'a pas réussi à ouvrir powerpoint
On Error GoTo 0

Set pptPres = pptApp.Presentations.Open(pathPPT, 1)
DoEvents

'boucler sur chaque forme de chaque diapositive
For Each pptSlide In pptPres.Slides
pptSlide.Select '/!\ ** obligé pour éviter un problème dans le centrage des Shapes (ReplacePptShapeArea)
nbShapes = pptSlide.Shapes.Count
For iShape = nbShapes To 1 Step -1
Set pptShape = pptSlide.Shapes(iShape)

'remplacer les variables "textes" une par une
For Each rowVar In tabVarTxt.ListRows
ReplacePptShapeText pptShape, "${" & rowVar.Range(1, 1).Text & "}", rowVar.Range(1, 2).Text
Next rowVar

'remplacer les variables "zones"
ReplacePptShapeArea pptShape, tabVarArea

Next iShape
Next pptSlide
pptPres.Slides(1).Select

'pptPres.SaveAs ...
'pptPres.Close

ExitSub:
Set fso = Nothing
If Not pptApp Is Nothing Then
If pptApp.Presentations.Count > 0 Then
pptApp.Visible = True
Else
pptApp.Quit
End If
End If
Set GenererPPT = pptPres
Set pptPres = Nothing
Set pptApp = Nothing
End Function

 

[Dranreb]

Re : VBA - Comment lancer une Function ?

Bonjour.

Si vous avez la référence, vous devez avoir les types de données explicites. Inutile donc de gérez les entités PowerPoint via des liaisons tardives à travers des Object. Utilisez les types de données faits pour ça.

Une Function se lance depuis une autre procédure en affectant à quelque chose ce qu'elle renvoie. Si c'est un objet, par Set :

Set MaPrésentPPt = GenererPPT

 

[Arnaud81]

Re : VBA - Comment lancer une Function ?

Merci Dranreb

Bon, je parviens à lancer la fonction par contre, le reste de votre post est du chinois pour moi...

 

[Arnaud81]

Re : VBA - Comment lancer une Function ?

La macro fonctionne correctement, excepté le fait que si je n'ouvre pas mon modèle ppt avant, ca plante...

Deuxième petite chose, est il possible d'enregistrer la présentation créée sous un autre nom (sans la fermer) avec la date du jour ? Du style "20150331 - Présentation reporting"

Merci d'avance

 

[Dranreb]

Re : VBA - Comment lancer une Function ?

Je ne connais malheureusement pas suffisamment PowerPoint pour vous en dire plus.