PowerPoint openen direct met custom template

[Djani]

Hoi allemaal,

Bij het bedrijf waar ik nu zit, wordt gewerkt met een standaard PowerPoint template/layout/office thema. Wat ik graag zou willen is dat - wanneer de PowerPoint m.b.v. VBA geopend wordt - direct de custom template bevat. Ik heb de template zelf opgeslagen als een .potx welke te vinden is de volgende folder: C:\Users\NE70090\AppData\Roaming\Microsoft\Templates\Document Themes\Theme Colors. Het bestandsnaam zelf heb ik "PPTLayout" genoemd met de gedachte dat ik hiernaartoe zou kunnen verwijzen met VBA.

Dit is een stukje code:

Option Explicit
 
Sub PPT()
     
    Dim iName As Long
    Dim rName As Range
    Dim nRange As Long
    Dim dSlideCenter As Double
    Dim pptApp As PowerPoint.Application
    Dim pptPre As PowerPoint.Presentation
    Dim pptSld As PowerPoint.Slide
    Dim objSheet As Worksheet
    Dim oshpR As PowerPoint.ShapeRange
     
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPre = pptApp.Presentations.Add
    
     
     ' loop the sheets
    For Each objSheet In ActiveWorkbook.Worksheets
         
         'Create new slide for the data
        Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)
        ActivePresentation.SlideMaster.Theme.ThemeColorScheme.Load ("C:\Users\NE70090\AppData\Roaming\Microsoft\Templates\Document Themes\Theme Colors")

Als ik echter op 'run' klik, dan krijg ik de volgende foutmelding: ActiveX component can't create object. Er wordt verwezen naar deze code:
ActivePresentation.SlideMaster.Theme.ThemeColorScheme.Load ("C:\Users\NE70090\AppData\Roaming\Microsoft\Templates\Document Themes\Theme Colors")

Ik werk met "Option Explicit", dus daardoor heb ik een aantal variabelen gedefinieerd.

Heeft iemand van jullie een oplossing? Ik denk waarschijnlijk te moeilijk..

Mvg,

Djani

 

[edmoor]

Je kan dat template toch als Standaard instellen? Dan heb je er geen code voor nodig:
http://echosvoice.com/how-to-set-a-default-template-in-powerpoint-2013/

 

[Djani]

Edmoor, bedankt voor je snelle reactie.

Je hebt inderdaad gelijk, maar het gaat veel 'moeite en energie' kosten om anderen dit ook te laten doen. Er zullen grofweg 10 verschillende mensen actief gebruikmaken van de rapportage. Het zal wat vreemd overkomen --> het bedrijf maakt gebruik van een standaard template, maar niet iedereen heeft de 'template file' bij de hand om zomaar te zeggen. Daarom wilde ik het vanuit een macro per direct laten doen!

Als het echt niet anders kan, dan maak ik desnoods wel een mini-handleiding voor hen.

Het zou natuurlijk prachtig zijn als dit wel via VBA gedaan kan worden.

 

[edmoor]

Misschien is het het handigste om het bestand Blank.potx te hernoemen naar Blank_Org.potx en de benodigde template Blank.potx te noemen.

 

[Djani]

Om heel eerlijk te zijn, dat verandert de situatie niet. Als ik de template benoem naar Blank.potx, dan hebben de presentaties inderdaad de gewenste template. Dat is in ieder geval mooi om te weten, dus bedankt daarvoor.

De macro die ik gebruik stelt mij in staat om meerdere tabellen/grafieken van een/meerdere worksheet(s) automatisch te kopieren en te plakken in verschillende slides van de PowerPoint. Echter, het probleem zit hem in het volgende: de PowerPoint die automatisch geopend en ingevult wordt d.m.v. de macro hanteert de 'normal template' en niet de gewenste. Ik heb het geprobeerd met 'Blank.potx' en 'Blank_Org.potx', maar helaas zonder resultaat.

 

[edmoor]

Ik heb nog nooit echt iets met VBA in Powerpoint gedaan dus heb geen antwoord op de vraag hoe je het daarin zou moeten doen helaas. Zal er vanavond ook eens naar kijken als je voor die tijd geen antwoord hebt.

 

[Djani]

Geen probleem. In ieder geval bedankt voor de tijd en moeite. Als je de VBA script wil hebben, let me know. Misschien komen wij er op die manier uit.

 

[edmoor]

Ik heb wat voor je in elkaar gefröbeld. Het werkt inderdaad niet zo makkelijk als in Excel maar ik heb wel een oplossing. Wellicht dat die voldoende voor je is. Mijn eerste VBA stapjes met Powerpoint

Download deze Powerpoint invoegtoepassing:
Bekijk bijlage autoevents.zip

Open een lege Powerpoint en voeg de AutoEvents.ppa invoegtoepassing toe als Powerpoint invoegtoepassing (Dus niet als COM invoegtoepassing). Ga nu naar de VB Editor, voeg een module toe en zet daar dit Subje in:

Sub Auto_Open()
   MsgBox ("welcome")
   Application.Presentations.Open ("C:\Users\Ed\Documents\Aangepaste Office-sjablonen\1710.potx")
End Sub

Uiteraard wijzig je het pad naar de template even naar wat voor jou van toepassing is en die MsgBox is uiteraard niet verplicht.

Wijzig in de Opties / Vertrouwenscentrum zodanig dat macro's mogen worden uitgevoerd en de toegang tot het VBA project vertrouwd is. Sla de presentatie nu op als bestand.pptm

Iedere keer als je nu dit bestand opent zal de macro worden uitgevoerd.
Dit werkt alleen met een invoegtoepassing, vandaar dat ik die heb meegeleverd.

Die Autpen is een event waarop dan wordt gereageerd door Powerpoint.
Beschikbare events zijn als volgt:

Sub Autpen() - Gets executed immediately after the presentation is opened.

Sub Auto_Close() - Gets executed prior to the presentation is closed.

Sub Auto_Print() - Gets executed prior to the presentation being printed.

Sub Auto_ShowBegin() - Gets executed when the show begins.

Sub Auto_ShowEnd() - Gets executed when the show ends.

Sub Auto_NextSlide(Index as Long) - Gets executed before the slideshow moves onto the next slide.
Index represents the SlideIndex of the Slide about to be displayed.

Ik hoop dat dit is wat je bedoeld of dat ik je er in ieder geval de juiste richting mee op help

De informatie en de addin komen hier vandaan en bevat een disclaimer:
http://skp.mvps.org/autoevents.htm

 

[Djani]

Thanks voor je tips. Ik zal er straks naar kijken. Ik heb gevonden hoe de PowerPoint geopend kan worden d.m.v. een macro, maar als ik die in combinatie met de (als eerste geposte) script uitvoer, dan wordt er per tabel/grafiek een aparte PowerPoint presentatie geopend --> wel met de gewenste layout natuurlijk. Echter, dit resulteert in grofweg 10 tot 20 verschillende PowerPoints. Ik zal de script hieronder zetten. Ik heb vrijwel alle elementen tot mijn beschikking, maar ik zou graag willen dat de onderstaande script de volgende logica bevat:
1. Open presentatie (met gewenste layout);
2. Tel hoeveel "ranges" in de verschillende worksheets er zijn;
3. Op basis van dat getal wil ik dat de PowerPoint automatisch x slides optelt;

Openen met Template:

Sub OpenPPTwithTemplate()
'
' OpenPPTwithTemplate Macro
Set pptApp = CreateObject("PowerPoint.Application")
 pptApp.Visible = True
 Set pptPre = pptApp.Presentations.Open(Filename:=Environ("APPDATA") & "\Microsoft\Templates\blank.potx", _
 Untitled:=True)

End Sub

Automatisch openen + copy/paste tabellen/grafieken in sheet(s):

Option Explicit
 
Sub PPT()
     
    Dim iName As Long
    Dim rName As Range
    Dim nRange As Long
    Dim dSlideCenter As Double
    Dim pptApp As PowerPoint.Application
    Dim pptPre As PowerPoint.Presentation
    Dim pptSld As PowerPoint.Slide
    Dim objSheet As Worksheet
    Dim oshpR As PowerPoint.ShapeRange
         
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPre = pptApp.Presentations.Add
     
     ' loop the sheets
    For Each objSheet In ActiveWorkbook.Worksheets
         
    
   
         'Create new slide for the data

        Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)
         
        If WorksheetFunction.Count(objSheet.UsedRange) > 0 Then
             ' Data in sheet so copy used range(s)
             
            For iName = 1 To 3
                 ' initialize
                Set rName = Nothing
                nRange = 0
                 
                 ' look for named range
                On Error Resume Next
                Set rName = objSheet.Range("RangeToCopy" & CStr(iName))
                On Error GoTo 0
                 
If Not rName Is Nothing Then ' counter
    nRange = nRange + 1
     ' copy range as picture
    rName.CopyPicture Appearance:=xlScreen, Format:=xlPicture
     ' paste the copied picture
    Set oshpR = pptSld.Shapes.Paste
     
     ' Align pasted shape
    oshpR.Align msoAlignCenters, True
    oshpR.Align msoAlignMiddles, True
End If
Next
 
Else
     ' No data in sheet, so copy chart
    objSheet.ChartObjects(1).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
     
     ' paste the copied picture
    Set oshpR = pptSld.Shapes.Paste
End If
 
 ' Align pasted shape
oshpR.Align msoAlignCenters, True
oshpR.Align msoAlignMiddles, True
         
        If nRange = 2 Then
            With pptSld.Shapes(pptSld.Shapes.Count - 1) ' first shape of two
                dSlideCenter = .Left + .Width / 2
                .Left = 1.5 * dSlideCenter - .Width / 2 ' center shape in left half of slide
            End With
            With pptSld.Shapes(pptSld.Shapes.Count) ' last shape of two
                .Left = 1.5 * dSlideCenter + .Width / 2 ' center shape in right half of slide
            End With
        End If
    Next
End Sub

Ik hoop dat jij/jullie mij verder kan/kunnen helpen!

Mvg,

Djani

 

[edmoor]

Je weet er meer van dan ik, maar ik wil best nog een keer meekijken vanavond

 

[Djani]

Het lijkt zo.. Ik ben geen programmeur o.i.d. Krijg veel hulp van mensen!

 

[OctaFish]

Misschien ook handig als je een voorbeeldje meepost van de gewenste PP sjabloon en een excelletje met wat grafiekjes. Of wil je dat we zelf gaan knutselen? Gaat namelijk allemaal van jouw tijd af .