Excel-VBA Solutions: Controlling PowerPoint from Excel

In this post I will show you how to automate PowerPoint from excel using vba. Let’s learn this using following example.

This is a simple database which contains data of several companies. Database contains data like vision, history, branches etc. of each company. So in this example we will create PowerPoint file for each company.

First, let’s learn how to start PowerPoint application from Excel.

Sub StartPowerPoint()

Dim oPPTApp As PowerPoint.Application

Set oPPTApp = CreateObject("PowerPoint.Application")
oPPTApp.Visible = msoTrue

End Sub

So if you run above macro it will launch PowerPoint application.

For this example we use PowerPoint template file which is saved at the folder where our database file is. I created this very simple PowerPoint template to show you how to automate various tasks from excel.

First we need to develop the program to loop through each row and create separate PowerPoint file for each company. So following is the starting part of our program.

Sub GeneratePowerPointFiles()

Dim WS As Worksheet

Dim i As Long

Dim PptFileName As String
Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim oPPTShape As PowerPoint.Shape
Dim oPPTSlide As PowerPoint.Slide

Set oPPTApp = CreateObject("PowerPoint.Application")
oPPTApp.Visible = msoTrue

Set WS = ActiveSheet

'find last row of WS
WS_LastRow = WS.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

For i = 2 To WS_LastRow

Next i

End Sub

Then within each loop, we need to open the template and do the editing. So we can open the PowerPoint template file for each loop like this.

For i = 2 To WS_LastRow
     If WS.Range("G" & i).Value <> "" Then
          DestinationPPT = ThisWorkbook.Path & "\" & "Company Template.pptx"
          Set oPPTFile = oPPTApp.Presentations.Open(FileName:=DestinationPPT)
     End If
Next i

Now let’s look at our first slide.

Here we need to put name of each company while loop through the rows. So we should replace “Company Name” with values in column A. To do that first we need to identify the names of objects inside the PowerPoint presentation. This post explains how to find names of objects in a PowerPoint presentation.

How to Find Names of Objects in a PowerPoint Slide

So if the name of the title object is “Title 1” then we can do it as follows.

oPPTFile.Slides(1).Shapes("Title 1").TextFrame.TextRange.Text = WS.Range("A" & i).Value

Now let’s move to our next slide.

We have a textbox in this slide. And the name of the textbox is “TextBox 4”. Here we need to put vision of each company.

oPPTFile.Slides(2).Shapes("TextBox 4").TextFrame.TextRange.Text = "Our Vision" & vbCrLf & vbCrLf & WS.Range("B" & i).Value

vbCrLf used to add space between title and the vision. And we have another different type of object in our next slide.

We have rectangle here and we need to put history of each company inside this rectangle. As the name of the rectangle is “Rectangle 3” we can automate it as follows.

oPPTFile.Slides(3).Shapes("Rectangle 3").TextFrame.TextRange.Text = WS.Range("C" & i).Value

Note that you need to put slide number before the object name. Because two different slides can have objects with same name. This is our next slide.

We have two types of objects in this slide. We need to put branch names in “Content Placeholder 2” object. We can do it like this.

oPPTFile.Slides(4).Shapes("Content Placeholder 2").TextFrame.TextRange.Text = WS.Range("D" & i).Value & vbCrLf & WS.Range("E" & i).Value & vbCrLf & WS.Range("F" & i).Value

Next we need to save the PowerPoint presentation with the name given in the column G.

PptFileName = WS.Range("G" & i).Value & ".pptx"
PptFileNameString = oPPTFile.Path & "\" & PptFileName
oPPTFile.SaveAs PptFileNameString

Also we need to close the original PowerPoint Template at the end of each loop.

'Close PowerPoint
oPPTFile.Close
Set oPPTFile = Nothing
DoEvents

So below is the full code of this VBA program.

Sub GeneratePowerPointFiles()

Dim WS As Worksheet

Dim i As Long

Dim PptFileName As String
Dim WebsiteAddress As String

Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim oPPTShape As PowerPoint.Shape
Dim oPPTSlide As PowerPoint.Slide

Set oPPTApp = CreateObject("PowerPoint.Application")
oPPTApp.Visible = msoTrue

Set WS = ActiveSheet

'find last row of WS
WS_LastRow = WS.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

For i = 2 To WS_LastRow
    If WS.Range("G" & i).Value <> "" Then

        DestinationPPT = ThisWorkbook.Path & "\" & "Company Template.pptx"
        Set oPPTFile = oPPTApp.Presentations.Open(FileName:=DestinationPPT)

        Application.Wait (Now + TimeValue("0:00:02"))
        DoEvents

        oPPTFile.Slides(1).Shapes("Title 1").TextFrame.TextRange.Text = WS.Range("A" & i).Value

        oPPTFile.Slides(2).Shapes("TextBox 4").TextFrame.TextRange.Text = "Our Vision" & vbCrLf & vbCrLf & WS.Range("B" & i).Value

        oPPTFile.Slides(3).Shapes("Rectangle 3").TextFrame.TextRange.Text = WS.Range("C" & i).Value

        oPPTFile.Slides(4).Shapes("Content Placeholder 2").TextFrame.TextRange.Text = WS.Range("D" & i).Value & vbCrLf & _ WS.Range("E" & i).Value & vbCrLf & WS.Range("F" & i).Value

        PptFileName = WS.Range("G" & i).Value & ".pptx"
        PptFileNameString = oPPTFile.Path & "\" & PptFileName
        oPPTFile.SaveAs PptFileNameString

        'Close PowerPoint
        oPPTFile.Close
        Set oPPTFile = Nothing
        DoEvents

    End If
Next i

oPPTApp.Quit

MsgBox "Completed!", vbInformation, ""

End Sub

So the result files will be created in the folder where our original PowerPoint template file is.

Excel-VBA Solutions

Pages

Controlling PowerPoint from Excel - VBA

Contact Form