title: EXCEL VBA adding a new slide to Powerpoint Automatically
body: <p>This is my code for exporting Contents from Excel to PowerPoint. My Problem is I have only one slide in the presentation. As the criteria is met,  VBA should automatically increase the slides and populate it. The slides should be of the same layout. After every IF and Else Loop I Need to add a new slide for the next Iteration. Using this code I get an error that Active X component cant create object. Any help ?  </p>
  
  <pre><code>Dim oPPTShape As PowerPoint.Shape
  Dim oPPTFile As PowerPoint.Presentation
  Dim SlideNum As Integer
  Dim pptSlide As PowerPoint.Slide
  Dim pptLayout As CustomLayout
  Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
                  strPresPath = "C:\Users\asehgal\Desktop\OPL\Presentation1.pptx"
  
              On Error Resume Next
              Set oPPTApp = GetObject(, "PowerPoint.Application")
  
                  If oPPTApp Is Nothing Then
  
  
  
                  Set oPPTApp = CreateObject("PowerPoint.Application")
                  oPPTApp.Visible = True 'msoTrue
  
                  End If
                  On Error GoTo 0
                  Set oPPTFile = oPPTApp.Presentations.Open(strPresPath)
                  SlideNum = 1
                  oPPTFile.Slides(SlideNum).Select
                  Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Table 1")
  
                  On Error Resume Next
                  If oPPTApp.Windows.Count &gt; 0 Then
                  Set oPPTFile = oPPTApp.ActivePresentation
  
                  Set pptSlide = oPPTFile.Slides(oPPTApp.ActiveWindow.Selection.SlideRange.SlideIndex)
                  Else
  
                      Set oPPTFile = oPPTApp.Presentations.Add
  
                      Set pptSlide = oPPTFile.Slides.AddSlide(1, ppLayout)
                  End If
                  On Error GoTo 0      
                  Do
              'if topics are same
              If (arrThema(p, 0) = arrThema(p + 1, 0)) Then
  
                  With oPPTShape.Table
                  .cell(1, 1).Shape.TextFrame.TextRange.text = arrThema(p, 0)
                  'if true Adda new slide here for the next iteration
                  End With
  
                  'If subtopics are also same
                  If (arrThema(p, 1) = arrThema(p + 1, 1)) Then
  
  
                  Else 'if subtopics are different
  
                  With oPPTShape.Table
  
                  .cell(2, 1).Shape.TextFrame.TextRange.text = arrThema(p, 1)
                  .cell(3, 2).Shape.TextFrame.TextRange.text = Beschreibung(p)
                  'if true Add a new slide here for the next iteration            
                  End With
  
                  oPPTFile.Slides(SlideNum).Select
                  Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Table 1")
                  With oPPTShape.Table
                  .cell(2, 1).Shape.TextFrame.TextRange.text = arrThema(p + 1, 1)
                  .cell(3, 2).Shape.TextFrame.TextRange.text = Beschreibung(p + 1)
                  'if true Adda new slide here for the next iteration
  
                  End With
  
                 ' MsgBox "Description : " &amp; Beschreibung(p)
                  End If
  
  
                  Else
  
  
                  'add a new slide here and add the details there
                  With oPPTShape.Table
                  .cell(1, 1).Shape.TextFrame.TextRange.text = arrThema(p, 0)
                  .cell(2, 1).Shape.TextFrame.TextRange.text = arrThema(p, 1)
                  .cell(3, 2).Shape.TextFrame.TextRange.text = Beschreibung(p)
  
      'if true Adda new slide here for the next iteration
  
                      'code for adding a new slide which does not work
                  Set pptLayout = ActivePresentation.Slides(1).CustomLayout
                 Set pptSlide = ActivePresentation.Slides.AddSlide(2, pptLayout)
  
                  End With
  
  
  
              End If
              p = p + 1
             Loop Until p = noThema
  </code></pre>