I'm currently making an automatic Powerpoint from excel using vba and I would like to set a theme to the document, the "Ion" theme to be precise. I have the following code:
Sub CreateFullPres()
Dim ppt As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp2 As Shape
'Create Powerpoint
Set ppt = New PowerPoint.Application
Set pres = ppt.Presentations.Add
ppt.Visible = True
'Add Slide
Set Slide1 = pres.Slides.Add(1, ppLayoutTitle).Shapes.Placeholders
SlideTitle = Sheets("FIBO Monthly Update").Range("B4")
SubTitle1 = Sheets("FIBO Monthly Update").Range("B6")
SubTitle2 = Sheets("FIBO Monthly Update").Range("B7")
Slide1.Item(1).TextFrame.TextRange.Text = SlideTitle
Slide1.Item(2).TextFrame.TextRange.Text = SubTitle1 & ": " & SubTitle2
The code continues after this but this is all that is necessary.
Thanks in advance.
pres.ApplyTheme {full path to your thmx file}
Finding the MS-supplied themes can be tricky. It'll be simpler if you create a presentation based on the Ion theme, save it as a THMX to a convenient location, then specify that path/file.thmx in the code above.
By the way, you'll also want to use
Dim shp2 As PowerPoint.Shape
instead of
Dim shp2 As Shape
which dims it as an Excel shape rather than a PowerPoint shape; they're likely to have different properties.
Related
#james wrote a while back in response to a similar question that the proper way to fo this is:
Sub CreatePres()
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppTextbox As PowerPoint.Shape
Set ppApp = New PowerPoint.Application
ppApp.Visible = True
ppApp.Activate
Set ppPres = ppApp.Presentations.Add
slidesCount = ppPres.Slides.Count
Set ppSlide = ppPres.Slides.Add(slidesCount + 1, ppLayoutTitle)
ppSlide.Shapes(1).TextFrame.TextRange.Text = "Hello world"
ppSlide.Shapes(2).TextFrame.TextRange.Text = Date
slidesCount = ActiveWindow.Selection.SlideRange.SlideIndex
Call slide2(slidesCount)
End Sub
Sub slide2(i As Integer)
Set ppSlide = ppPres.Slides.Add(i + 1, ppLayoutTitle)
ppSlide.Select
ppSlide.Shapes(1).TextFrame.TextRange.Text = "Hello world"
ppSlide.Shapes(2).TextFrame.TextRange.Text = Date
End Sub
I am however getting a "By ref mismatch Argumnenr error on the 'Call Slide2(slidecount)'-- it's the las line of the first sub.
I'm using Office 365 on Windows 10 Pro.
Thanks in advance
You didn't DIM your slidesCount variable, so VBA creates a variant when you assign a value to it. Your Sub slide2 expects an integer, so it throws an error.
To save further trouble like this, ALWAYS put Option Explicit at the top of every module. That'll prevent undeclared variables from causing problems like this.
Go to Tools | Options and put a check next to Require Variable Declaration to have VBA automatically insert Option Explicit for you.
It's also a good idea to use the correct variable type. Any .Count value in the PPT object model will be a Long, not an integer. VBA will generally convert between the two when it figures it needs to. Usually it's right. Sometimes it's not. Then it all hits the fan.
We typically use powerpoint to facilitate our experiments. We use "sections" in powerpoint to keep groups of slides together for each experimental task. Moving the sections to counterbalance the task order of the experiment has been a lot of work!
I thought we might be able to predefine a counterbalance order (using a string of numbers representing the order) in a CSV or array (haven't built that out yet in VBA). Then using VBA to move the sections and save the file for each order. I am pretty rusty using VBA but I think I have a pretty good start. The problem is on line 24. I have no idea how to copy the section to the new presentation. Is anyone familiar enough to steer me down the right path.
Sub Latin_Square()
Dim amountOfSubjects As Integer
'Declare the amount of subjects you have in your study
amountOfSubjects = 14
Dim filePath As String
filePath = "C:/1.pptx"
Dim amountofsections As Integer
Dim i As Integer
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim desktopPath As String
'find out where user's desktop is
desktopPath = Environ("UserProfile") & "\Desktop\"
Dim oldPresentation As Presentation
Dim newPresentation As Presentation
'open the target presentation
Set oldPresentation = Presentations.Open("C:\1.pptx")
For i = 1 To oldPresentation.Slides.Count
oldPresentation.Slides.Item(i).Copy
newPresentation.Item(1).Slides.Paste
Next i
oldPresentation.Close
With newPresentation
.SaveCopyAs _
FileName:=fso.BuildPath(desktopPath, "Test" & 1 & ".pptx"), _
FileFormat:=ppSaveAsOpenXMLPresentation
End With
End Sub
If you want to copy slides with their sections, then you can not paste the slide by newPresentation.Slides.Paste only, as that moves the section of the last slide to the newly pasted slide.
Here's an example how to copy slide-by-slide, check if a slide is the beginning of a section, and how to add a new section then:
Public Sub CopySlidesWithSections()
Dim oldPresentation As Presentation, newPresentation As Presentation
Dim oldSlide As Slide, newSlide As Slide
Dim oldSectionProperties As SectionProperties, newSectionProperties As SectionProperties
Dim i As Integer
Set oldPresentation = ActivePresentation
Set oldSectionProperties = oldPresentation.SectionProperties
Set newPresentation = Application.Presentations.Add
Set newSectionProperties = newPresentation.SectionProperties
For Each oldSlide In oldPresentation.Slides
oldSlide.Copy
' Would lead to wrong sectioning: Set newSlide = newPresentation.Slides.Paste.Item(1)
Set newSlide = newPresentation.Slides.Paste(newPresentation.Slides.Count + 1).Item(1)
For i = 1 To oldSectionProperties.Count
If oldSectionProperties.FirstSlide(i) = oldSlide.SlideIndex Then
newSectionProperties.AddBeforeSlide _
newSlide.SlideIndex, _
oldSectionProperties.Name(i)
Exit For
End If
Next i
Next oldSlide
End Sub
Sub printDashboard()
Dim sheet1 As Excel.Worksheet
Set sheet1 = ActiveWorkbook.Sheets("PM Dashboard")
Dim pptChart2 As Excel.ChartObject
'Open PowerPoint template
Dim sPath As String
sPath = ActiveWorkbook.Path
Dim pp As PowerPoint.Application, pps As PowerPoint.Presentation
Set pp = New PowerPoint.Application
pp.Visible = True
Set pps = pp.Presentations.Open(sPath & "\template_Slides.pptx")
Dim firstSlide As PowerPoint.Slide
Set firstSlide = pps.Slides(1)
'Paste the second chart
Set pptChart2 = sheet1.ChartObjects("chartPM2")
pptChart2.Copy
Dim myShape2 As Object
Set myShape2 = firstSlide.Shapes.PasteSpecial()
'myShape2.Chart.ApplyChartTemplate (sPath & "\pipelineManagementChartFormat.crtx")
With myShape2
.Top = 1.52 * 72
.Left = 5.33 * 72
.Width = 4.08 * 72
.Height = 2.6 * 72
End With
End Sub
So this code works perfectly in that it:
Correctly opens the PowerPoint file
The Excel chart is pasted in and resized / repositioned
However, I can not figure out how to apply a saved chart template that I have within the same directory. You can see that I have tried to accomplish this with the "ApplyChartTemplate" line that is commented out in the "Paste Second Chart" section.
I would appreciate any help here. I have tried a number of different ways to apply the chart template after pasting it into the slide. I have not had any success with that yet.
Thanks
PasteSpecial returns a shaperange, not shape, but you need to apply a template to a single shape (ie, the chart object). Try this instead:
Set myShape2 = firstSlide.Shapes.PasteSpecial()(1)
It may be a machine-dependant timing issue (pasting from the clipboard can result in the VBA code running ahead prior to the paste operation completing). Try calling this Delay sub immediately after the PasteSpecial line.
Delay 1, True
Public Sub Delay(Seconds As Single, Optional DoAppEvents As Boolean)
Dim TimeNow As Long
TimeNow = Timer
Do While Timer < TimeNow + Seconds
If DoAppEvents = True Then DoEvents
Loop
End Sub
I'm trying to apply a template to a powerpoint through excel. The powerpoint template is embedded within my excel file via insert -> Object. I've successfully used the .applytemplate method to apply a template from file, but I cannot adjust the code to reference the embedded powerpoint template. I tried using OLEObject, but I'm afraid that isn't correct. Please review below code.
Sub ppCreate()
Dim myPP As PowerPoint.Application
Dim myPres As PowerPoint.Presentation
Dim activeSlide As PowerPoint.Slide
Dim ppObj As OLEObject
' Create instance of PowerPoint
Set myPP = CreateObject("Powerpoint.Application")
' For automation to work, PowerPoint must be visible
myPP.Visible = True
' Create a presentation
Set myPres = myPP.Presentations.Add
' Set slide view to Slide Only
myPP.ActiveWindow.ViewType = ppViewSlide
'Resize to 4:3
myPres.PageSetup.SlideSize = 2
'Add a slide
Set activeSlide = myPres.Slides.Add(1, ppLayoutBlank)
'Import Template
Worksheets("CBRDATA").Select
Set ppObj = ActiveSheet.OLEObjects("ppObj") 'NOT WORKING
myPres.ApplyTemplate (ppObj) 'NOT WORKING
myPres.ApplyTemplate "C:\CBR_TEMPLATE_COVER.potx" 'WORKING
Worksheets("CBR").Select
End Sub
Update:
'Test if template exists in C:\
If Dir("C:\CBR_TEMPLATE_COVER.potx") = "" Then
'Open/Save the embedded template to C:\
Set tempPP = CreateObject("Powerpoint.Application")
Worksheets("CBRDATA").OLEObjects("ppObj").Verb 0
tempPP.Visible = True
Set tempPres = tempPP.ActivePresentation
tempPres.SaveCopyAs ("C:\CBR_TEMPLATE_COVER.potx")
tempPres.Close
Else:
End If
' Create instance of PowerPoint
Set myPP = CreateObject("Powerpoint.Application")
This doesn't work because ActiveSheet.OLEObjects("ppObj") is type OLEObject, not PowerPoint.Presentation.
Set ppObj = ActiveSheet.OLEObjects("ppObj") 'NOT WORKING
While manually double-clicking on the object open the POTX file (actually it opens a new blank PPTX using the POTX as template), your assignment statement above isn't doing any of that, it's trying instead to put an OLEObject where a Presentation is expected, and that will always fail.
So, how to "open" the OLEObject? OLEObject has a .Verb method, and the following will perform the object's default action, which in the case of embedded package objects, is usally to "open" them.
The Solution
'Import Template
'## This should Open the template
Worksheets("CBRDATA").OLEObjects("ppObj").Verb 0
'## Assign the ActivePresentation to your ppObj variable
Set ppObj = myPP.ActivePresentation
Editorializing: Embedded OLEObjects are notoriously problematic, and probably not an ideal place to story things like document templates :)
I am currently experiencing a strange error. We have developed a tool that is used by many people and ONE of them has problems after he got a new computer.
The macro opens a PPT file located on the network (the user has access to the presentation - I tested this).
Here is the code:
Dim ppapp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim MyPath
MyPath = Workbooks("MyTool.xls").Sheets("Update").Range("start")
Set ppapp = New PowerPoint.Application
ppapp.WindowState = ppWindowMinimized
ppapp.Visible = True
Set PPPres = ppapp.Presentations.Open(MyPath, msoTrue, msoTrue)
The macro fails at this line:
Set PPPres = ppapp.Presentations.Open(MyPath, msoTrue, msoTrue)
Run-time error -2147467259 (80004005): PowerPoint could not open the file
The strange thing is that it works for all users except one.
The platform is Win7 and Excel 2010.
Any help is much appreciated!
Disclaimer on my answer with a limited knowledge of programming and VBA. My only experience is through excel and word.
Is it a problem with the office excel reference library is it? It may be better to make the code late bind rather than early bind if you've got the program go to different systems.
Dim the Powerpoint application and presentation as objects and change references to their numerical values.
Dim ppapp As Object
Dim PPPres As Object
Dim MyPath
MyPath = Workbooks("MyTool.xls").Sheets("Update").Range("start")
Set ppapp = New PowerPoint.Application
ppapp.WindowState = 2 'this would have to be changed to the numerical code; ppWindowMinimized = 2
ppapp.Visible = True
Set PPPres = ppapp.Presentations.Open(MyPath, -1, -1) 'these would also may have to be changed, not sure though - -1 = msoTrue.