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.