Add slide in Powerpoint via Excel

hi guys. via excel, i open a powerpoint template inside my com (named PptTemplate.pptx) and transfer the values of column A & B to the slides. this is my current code:

Sub ExcelToPpt()

'taken from http://stackoverflow.com/questions/20472964/replace-a-powerpoint-shape-in-excel-vba-without-changing-its-position-number

Dim oPPApp As Object, oPPPrsn As Object, oPPSlide As Object
Dim oPPShape As Object
Dim FlName As String

'~~> Change this to the relevant file
FlName = ThisWorkbook.Path & "\PptTemplate.pptx"

'~~> Establish an PowerPoint application object
On Error Resume Next
Set oPPApp = GetObject(, "PowerPoint.Application")

If Err.Number <> 0 Then
    Set oPPApp = CreateObject("PowerPoint.Application")
End If
Err.Clear
On Error GoTo 0

oPPApp.Visible = True

'~~> Open the relevant powerpoint file
Set oPPPrsn = oPPApp.Presentations.Open(FlName)

CountX = 1

With ThisWorkbook.Sheets("Sheet1")
LR = .Cells(Rows.Count, 1).End(xlUp).Row

For RowX = 2 To LR
If .Cells(RowX, "A") <> vbNullString Then
    '~~> Change this to the relevant slide which has the shape
    Set oPPSlide = oPPPrsn.Slides(CountX)
    '~~> Change this to the relevant shape
    Set oPPShape = oPPSlide.Shapes(1)
    Set oPPShape2 = oPPSlide.Shapes(2)
    '~~> Write to the shape
    oPPShape.TextFrame.TextRange.Text = .Cells(RowX, "A").Value
    oPPShape2.TextFrame.TextRange.Text = .Cells(RowX, "B")
    CountX = CountX + 1
End If
Next RowX

End With

End Sub

my question is how do i add slides based on the variable rows in my excel file? the slides must also be of the same design of my current slides. tried the code below but i got an error run-time error 429

Hi benishiryo,

Thanks for all the help your posts have given me over the years. I didn't try your code. I modified existing code that I had.

Try the following Macro which:
a. Opens the PowerPoint file.
b. Puts Text in the first 2 TextBoxes of Existing Slides until data runs out.
c. If there are not enough slides, the last slide is duplicated as required.
d. If there are too many slides, the extras are deleted.
e. Saves and closes the PowerPoint file.

Sub PowerPointPopulateSlides()

  Const POWERPOINT_SHOWMAXIMIZED = 3
  Const POWERPOINT_SHOWNORMAL = 1
  Const POWERPOINT_SHOWMINIMIZED = 2
  
  Dim ppt As Object
  Dim pptPresentation As Object
  Dim pptSlide As Object
    
  Dim i As Long
  Dim iExistingSlideCount As Long
  Dim iLastRow As Long
  Dim iRow As Long
  Dim iShapeCount As Long
  Dim iSlideCount As Long
  
  Dim sPathAndFileName As String
  Dim sValueColumnA As String
  Dim sValueColumnB As String
  
#Const Lewis = False
#If Lewis = True Then
  sPathAndFileName = ThisWorkbook.Path & "\ExcelForumPutTextInPowerPointSlides.ppt"
#Else
  sPathAndFileName = ThisWorkbook.Path & "\PptTemplate.pptx"
#End If

  'Get the Last Row Used in Column 'A'
  iLastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
  
  If iLastRow < 2 Then
    MsgBox "NOTHING DONE.  There is no data to put in the PowerPoint Slides."
    Exit Sub
  End If
 
 
 'Create the PowerPoint Application using Late Binding (no need for library)
  Set ppt = CreateObject("PowerPoint.Application")
  
  'Open the 'PowerPoint' file
  'Make the 'PowerPoint' file Visible
  With ppt
    .Visible = True
    Set pptPresentation = .Presentations.Open(Filename:=sPathAndFileName)
    .Visible = True
    .WindowState = POWERPOINT_SHOWMINIMIZED
  End With
  
  'Get the number of slides in the original PowerPoint File
  iExistingSlideCount = pptPresentation.Slides.Count
  
#If NEED_EXISTING_SLIDE_TEXTBOX_TEXT Then
  'Get debug output of the current contents of the existing slides
  For i = 1 To iExistingSlideCount
    iShapeCount = pptPresentation.Slides(i).Shapes.Count
  
    If iShapeCount >= 1 Then
      Debug.Print i, iShapeCount, 1, pptPresentation.Slides(i).Shapes(1).TextFrame.TextRange.Text
    End If
    If iShapeCount >= 2 Then
      Debug.Print i, iShapeCount, 1, pptPresentation.Slides(i).Shapes(2).TextFrame.TextRange.Text
    End If
  Next i
#End If
  
  
  'Initialize the Slide Count
  iSlideCount = 0
  
  For iRow = 2 To iLastRow
  
    'Increment the Slide Count
    iSlideCount = iSlideCount + 1
    
    'Create a New Slide if there are no more existing slides to populate
    If iSlideCount > iExistingSlideCount Then
      pptPresentation.Slides(pptPresentation.Slides.Count).Duplicate
    End If
  
    'Create the Slide Object
    Set pptSlide = pptPresentation.Slides(iSlideCount)
  
    'Get the Data from the Worksheet
    sValueColumnA = Trim(ThisWorkbook.Sheets("Sheet1").Cells(iRow, "A").Value)
    sValueColumnB = Trim(ThisWorkbook.Sheets("Sheet1").Cells(iRow, "B").Value)
    
    'Count the Number of Shapes on this slide
     iShapeCount = pptPresentation.Slides(iSlideCount).Shapes.Count
     iShapeCount = pptSlide.Shapes.Count
     
    'Put the Data in the Slides
    If iShapeCount >= 1 Then
      pptPresentation.Slides(iSlideCount).Shapes(1).TextFrame.TextRange.Text = sValueColumnA
      pptSlide.Shapes(1).TextFrame.TextRange.Text = sValueColumnA
    End If
    If iShapeCount >= 2 Then
      pptPresentation.Slides(iSlideCount).Shapes(1).TextFrame.TextRange.Text = sValueColumnA
      pptSlide.Shapes(2).TextFrame.TextRange.Text = sValueColumnB
    End If
    
  Next iRow
  
  'Delete Extra Slides from the back to the front
  While pptPresentation.Slides.Count > iSlideCount
    pptPresentation.Slides(pptPresentation.Slides.Count).Delete
  Wend
  
  
  'Close PowerPoint
  If Not pptPresentation Is Nothing Then
    pptPresentation.Save
    pptPresentation.Close
  End If
  
  'Quit the PowerPoint application
  If Not ppt Is Nothing Then
    ppt.Quit
  End If
  
  MsgBox "PowerPoint File has been updated."

MY_EXIT:
  'Clear the object pointers
  Set pptPresentation = Nothing
  Set ppt = Nothing
  Set pptSlide = Nothing
End Sub

Lewis

The following added Nov 25, 2015:
For anyone wanting to try this out with minimal effort, I am adding the following files in the .zip file attachment:
a. ExcelForumPutTextInPowerPointSlides.xls
b. ExcelForumPutTextInPowerPointSlides.ppt

Links to PowerPoint automation references:
http://www.globaliconnect.com/excel/...=79&Itemid=475
http://www.mahipalreddy.com/vba/ppvba.htm
http://peltiertech.com/Excel/XL_PPT.html

hi LJMetzger. glad to know that my posts have helped you before~ and now you are helping me! was initially worried i wouldn't understand from your code since you didn't add on to mine, but the comments you placed inside were extremely helpful. works brilliantly. thank you!
=)