VBA to create PowerPoint slides from Excel Data

[RayMAsa]

I am trying to make a change to a VBA script. The VBA script is from Contexture (Create PowerPoint Slides From Excel List with Free Macros). Essentially the VBA takes data from Excel and automatically creates PowerPoint slides. It works as designed with two columns. However, I need more data in each slide (possibly as many as 20), so I need 20 columns. When I add more columns, the script does not work. It gives me an error message after creating the first slide:

“Could not complete slides”



I made the following changes to the script (Please see below for full script):

• Added more Dim for additional columns
• Dim col04 As Long
• Dim col05 As Long
• Etc
• Added more to 'columns with text for slides
• col04 = 4
• col05 = 5
• etc
• Added more 'change text in for textbox
• myDup.Shapes(4).TextFrame.TextRange.Text _
• = myRng.Cells(i, col04).Value
• myDup.Shapes(5).TextFrame.TextRange.Text _
• = myRng.Cells(i, col05).Value
• Etc

Do I need to make any other changes?



Thanks for your help.

Ray


- Full Code

Sub CreateSlides_Text2()
'[URL='https://www.contextures.com']Contextures Excel Resources to Help You Succeed[/URL]
'create slide for each name in list
'fill two text boxes
Dim myPT As Presentation
Dim xlApp As Object
Dim wbA As Object
Dim wsA As Object
Dim myList As Object
Dim myRng As Object
Dim i As Long
Dim col01 As Long
Dim col02 As Long

'columns with text for slides
col01 = 1
col02 = 2

On Error Resume Next
Set myPT = ActivePresentation
Set xlApp = GetObject(, "Excel.Application")
Set wbA = xlApp.ActiveWorkbook
Set wsA = wbA.ActiveSheet
Set myList = wsA.ListObjects(1)
On Error GoTo errHandler

If Not myList Is Nothing Then
 
  Set myRng = myList.DataBodyRange
 
  For i = 1 To myRng.Rows.Count
      With myPT
        'Copy first slide, paste after last slide
         .Slides(1).Copy
         .Slides.Paste (myPT.Slides.Count + 1)
     
         'change text in 1st textbox
         .Slides(.Slides.Count) _
           .Shapes(1).TextFrame.TextRange.Text _
             = myRng.Cells(i, col01).Value
        
         'change text in 2nd textbox
         .Slides(.Slides.Count) _
           .Shapes(2).TextFrame.TextRange.Text _
             = myRng.Cells(i, col02).Value
      End With
  Next
Else
  MsgBox "No Excel table found on active sheet"
  GoTo exitHandler
End If

exitHandler:
  Exit Sub
errHandler:
  MsgBox "Could not complete slides"
  Resume exitHandler
End Sub

 

[smozgur]

Welcome to the MrExcel Message Board!

1. If you comment out the On Error Goto errHandler line, then you will see the exact code line that fails, so it would tell more information about the problem.
2. I am almost sure the failing line will be the following line (I am not sure why you are skipping the third column but just talking according to your description):.Shapes(4).TextFrame.TextRange.Text = myRng.Cells(i, col04).Value
   So, the question is: Did you also update the PowerPoint presentation file to add more shapes to the base slide? I don't know the final code you are using but I can tell that you need at least 5 shape objects in the base slide.
3. I suggest copying and pasting the actual code you updated and are using and which is failing as it will provide more information to any helper

Note: I edited your original post above and used VBA BB Code tags to wrap the code snippets you posted as it is more readable and copyable. That would be great if you could also use BB Codes to post code snippets. You can simply select the code you pasted in the editor, and click on the VBA icon on the editor toolbar for VBA codes, XLS for Excel functions, etc.