VBA: Create PowerPoint Slide for Each Row in Excel Workbook

This may seem like a really weird thing to want to do. Imagine this though: You want a presentation to show off the names of a lot of students on a constant loop at a kiosk, and you don’t want to have to retype the names. VBA to the rescue.

This little snippet of code will do the following:

  1. Open a given Excel Document
  2. For Each used row in column A of sheet 1, create a copy the first slide in the presentation.
  3. Change the text of the first text box to the content of that cell

Easy. Here it is:

Sub CreateSlides()
'Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open("C:\list.xlsx")
'Grab the first Worksheet in the Workbook
Dim WS As Excel.Worksheet
Set WS = OWB.Worksheets(1)
'Loop through each used row in Column A
For i = 1 To WS.Range("A65536").End(xlUp).Row
    'Copy the first slide and paste at the end of the presentation
    ActivePresentation.Slides(1).Copy
    ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)

    'Change the text of the first text box on the slide.
    ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value
Next
End Sub

Paste this into a new module inside your PowerPoint presentation. You will need to add in a reference to Microsoft Excel Objects (Tools -> References). Change the name and location of the Excel file that you want to use.

If you set up the first slide exactly as you want it before running the macro, then the same formats and layout will be copied too. Alternatively use Slide Masters to set up all the slides after they have been created.

Extension – by request

This edit below looks at each row and determines the number of used columns in that row. For each row, a text box is populated on the slide with all of the values in that row, with a carriage return between each value.

Sub CreateSlides()
'Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open("C:\list.xlsx") 'Grab the first Worksheet in the Workbook
Dim WS As Excel.Worksheet
Set WS = OWB.Worksheets(1)
Dim str As String
'Loop through each used row in Column A
For i = 1 To WS.Range("A65536").End(xlup).Row
    'Copy the first slide and paste at the end of the presentation
    ActivePresentation.Slides(1).Copy
    ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)

    'Get the number of columns in use on the current row
    Dim LastCol As Long
    LastCol = WS.Rows(i).End(xlToRight).Column
    If LastCol = 16384 Then LastCol = 1 'For some reason if only column 1 has data it returns 16384, so correct it

    'Build a string of all the columns on the row
    str = ""
    For j = 1 To LastCol
        If j <> 1 Then str = str & Chr(13)
        str = str & WS.Cells(i, j).Value
    Next

    'Write the string to the slide
    ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = str

Next
End Sub

Listing Shapes on the First Slide
One of the main issues with this script is identifying the shapes on the slides. The section of VBA code below will show a message box for each shape on the first slide which details the shape ID, the name of the shape and the type of the shape. The shape ID can then be inserted into the code above:

You will need both the ListShapes sub and the ShapeType function. Run the ListShapes macro, and each shape will be listed.

Sub ListShapes()
    If ActivePresentation.Slides(1).Shapes.Count = 0 Then
        MsgBox "No shapes on slide 1?"
    Else
        For i = 1 To ActivePresentation.Slides(1).Shapes.Count
            MsgBox "Shape Number " & i & Chr(13) & _
                   "Shape Name: " & ActivePresentation.Slides(1).Shapes(i).Name & Chr(13) & _
                   "Shape Type: " & ShapeType(ActivePresentation.Slides(1).Shapes(i).Type)
        Next
    End If
End Sub

Function ShapeType(ShapeTypeInt)
    Select Case ShapeTypeInt
        Case 1: ShapeType = "Autoshape"
        Case 2: ShapeType = "Callout"
        Case 3: ShapeType = "Chart"
        Case 4: ShapeType = "Comment"
        Case 5: ShapeType = "Freeform"
        Case 6: ShapeType = "Group"
        Case 7: ShapeType = "Embedded OLE Object"
        Case 8: ShapeType = "Form Control"
        Case 9: ShapeType = "Line"
        Case 10: ShapeType = "Linked OLE Object"
        Case 11: ShapeType = "Linked Picture"
        Case 12: ShapeType = "OLE Control Object"
        Case 13: ShapeType = "Picture"
        Case 14: ShapeType = "Placeholder (for titles, etc)"
        Case 15: ShapeType = "WordArt"
        Case 16: ShapeType = "Media"
        Case 17: ShapeType = "Text Box"
        Case 18: ShapeType = "Script Anchor"
        Case 19: ShapeType = "Table"
        Case 20: ShapeType = "Canvas"
        Case 21: ShapeType = "Diagram"
        Case 22: ShapeType = "Ink"
        Case 23: ShapeType = "Ink Comment"
        Case -2: ShapeType = "Mixed Type Shape"
        Case Else: ShapeType = "Unknown Shape Type"
    End Select
End Function

17 people found this post useful.
Posted in Office 2010 and tagged , . Bookmark the permalink. RSS feed for this post. Leave a trackback.

19 Responses to VBA: Create PowerPoint Slide for Each Row in Excel Workbook

  1. Don says:

    I am having an issue getting this to work, I have changed both the file name and path but I still keep getting an error.
    Compile error
    User-defined type not defined
    it refers to line 3
    Dim OWB As New Excel.Workbook
    and it is highlighting OWB As New Excel.Workbook

    • Craig says:

      You will need to add a reference to the Excel objects in order for them to be available in PowerPoint.

      To do this, open up the VBA code view, go to Tools –> References. Put a check in the box next to Microsoft Excel xx Object Library. xx will refer to the version of Excel that you have installed. Re run the code then and it should work.

      • Don says:

        Thanks That fixed that problem but now it is giving me a new error
        Run-time error ‘ -2147188160(800482240)':
        Shapes (unknown member): Integer out of range. 1 is not in the valid range of 1 to 0
        and it refers to this line
        ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = str
        thanks for all the help so far and any you may be able to give on this problem

        • Craig says:

          This is telling you that you are trying to write text into a shape that doesn’t exist.

          The script requires that the first slide in your presentation has a text box on it. This is the first shape on the slide. If you wanted to populate a different shape number, then you can change the value in this line.

          This little snippet below will show you the details of all of the shapes on the first slide and allow you to find out the appropriate shape number:

          Sub ListShapes()
          If ActivePresentation.Slides(1).Shapes.Count = 0 Then
          MsgBox (“No shapes on slide 1″)
          Else
          For i = 1 To ActivePresentation.Slides(1).Shapes.Count
          MsgBox (“Shape Number ” & i & “: ” & ActivePresentation.Slides(1).Shapes(i).Name)
          Next
          End If
          End Sub

  2. Satya says:

    Does this work with excel 2007 as well?

  3. Christopher says:

    Thank you so much for this informational post! I added a few things to it because I needed to create slides with multiple fields. I also added code for a file open dialog so I can reuse it if needed.

    I kept running into an issue where it couldn’t refer back to the PowerPoint object once I did the Excel open, so I changed the way it works a little. I grab the formatting from the active slide and populate a CustomLayout object with it. Then instead of copying it, I add a new slide based on that layout. I use the Slides.Count + 1 to always add it to the end.

    Here is what I came up with:
    Sub CreateSlides()
    ‘Dim the Excel objects
    Dim objWorkbook As New Excel.Workbook
    Dim objWorksheet As Excel.Worksheet

    ‘Dim the File Path String
    Dim strFilePath As String

    ‘Dim the PowerPoint objects
    Dim pptSlide As Slide
    Dim pptLayout As CustomLayout
    Dim pptNewSlide As Slide

    ‘Get the layout of the first slide and set a CustomLayout object
    Set pptLayout = ActivePresentation.Slides(1).CustomLayout

    ‘Run the OpenFile function to get an Open File dialog box. It returns a String containing the file and path.
    strFilePath = OpenFile()

    ‘Open the Excel file
    Set objWorkbook = Excel.Application.Workbooks.Open(strFilePath)

    ‘Grab the first Worksheet in the Workbook
    Set objWorksheet = objWorkbook.Worksheets(1)

    ‘Loop through each used row in Column A
    For i = 1 To objWorksheet.Range(“A65536″).End(xlUp).Row

    Set pptNewSlide = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, pptLayout)

    ‘Change the text of the first text box on the slide.
    pptNewSlide.Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value
    pptNewSlide.Shapes(2).TextFrame.TextRange.Text = WS.Cells(i, 2).Value
    pptNewSlide.Shapes(3).TextFrame.TextRange.Text = WS.Cells(i, 3).Value

    Next
    End Sub

    Function OpenFile()
    ‘Dim the File Dialog object and string
    Dim objFileDialog As FileDialog
    Dim strFile As String

    ‘Set the objFileDialog to an instance of the FileDialog object
    Set objFileDialog = Application.FileDialog(msoFileDialogFilePicker)

    ‘Set the Properties of the objFileDialog object
    objFileDialog.AllowMultiSelect = False
    objFileDialog.ButtonName = “Select”
    objFileDialog.InitialView = msoFileDialogViewDetails
    objFileDialog.Title = “Select Excel File”
    objFileDialog.InitialFileName = “%USERPROFILE%\Desktop”
    objFileDialog.Filters.Clear
    objFileDialog.Filters.Add “Excel”, “*.xls; *.xlsx”, 1
    objFileDialog.FilterIndex = 1

    ‘Show the FileDialog box
    objFileDialog.Show

    ‘Set strFile to the first record of the SelectedItems property of our FileDialog
    strFile = objFileDialog.SelectedItems(1)

    ‘Return the File Path string
    OpenFile = strFile
    End Function

    Thanks again!

    • Craig says:

      Wow Chris! Thanks for the enhancement.

      • Tushar says:

        Hi – I am getting a Run-time error ‘424’ Object Required.

        pptNewSlide.Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value

        not sure what step I am not following. I have created a ppt with 4 shapes, custom layout. Please advice. Thanks…

        • Craig says:

          This is a bit of a guess, but if your slide has multiple shapes, then it could be that pptNewSlide.Shapes(1) is not a text box shape, but instead is a different type of shape which does not have a TextFrame property.

          Try running the ListShapes sub that I have just added to the post to list all of the shapes and their type to verify that you have the correct shapes.

  4. Stan says:

    Hi,

    This is awesome… Is it possible to grab the entire row, not just the first cell of each row? For example, I want to grab as many rows as are filled, and every column filled in that row.

    So row 1, A-G
    Row 2, A-F
    Row 3, A- P
    Row 4, C-G

    etc.

    is this possible?

  5. Steve says:

    I know this question will sound scarily stupid to you, but I think what you wrote is exactly what I want, but I have so little knowledge of VBA, and everything else it seems, that I need to ask: What locations in your code are the variables I would need to change? Meaning, do I only change your text “Open(“C:\list.xlsx”) by substituing the C:\list.xlsx to the directory and filename of my file? And, what about that line you wrote “Change the filename here.”?
    Thank you very much, by the way!

    • Craig says:

      The only line that you need to update in order to make this work is the one with the filename that you have already identified. So yes, just change C:\list.xlsx to the path and location of your Excel file.

      Of course, if you want to use this as a base to do more complex things with the imported data then you can by editing the bits between the For-Next loop at the bottom.

  6. Keven says:

    Thanks! It’s awesome.

    For newbies like me, when he talks about new module:
    ALT+F11 > right click on your project at the top left and choose New Module. Copy paste the above content.
    From the VBA window, you will find the Tools > Reference he’s talking about.
    Save (choose no and select macro enable type).
    Back to the PPT, open the Macro window (ALT+F8) and run CreateSlide.

    It’s magical :)

  7. Arturo says:

    Thanks for posting your script, I found it very helpful. I wanted to see if you could help me it the script to insert the following. For example. slide 1::Row 1, Column A, Slide 2: Row 1 Column B slide 3: Row 2, Column A, Slide 4: Row 2 Column B and then continue the loop until the end. Thanks.

    • Craig says:

      Yes, using the code below. All we do is add in an extra Copy slide, then pull the value in from the 2nd column in for each iteration. A note though, this still only loops for all values in column A, so if column B is longer than column A, those extra records wont be included.

      Sub CreateSlides()’Open the Excel workbook. Change the filename here.
      Dim OWB As New Excel.Workbook
      Set OWB = Excel.Application.Workbooks.Open(“C:\list.xlsx”)’Grab the first Worksheet in the Workbook
      Dim WS As Excel.Worksheet
      Set WS = OWB.Worksheets(1)’Loop through each used row in Column A
      For i = 1 To WS.Range(“A65536″).End(xlUp).Row
      ‘Copy the first slide and paste at the end of the presentation
      ActivePresentation.Slides(1).Copy
      ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)

      ‘Change the text of the first text box on the slide.
      ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value

      ‘Copy the first slide and paste at the end of the presentation
      ActivePresentation.Slides(1).Copy
      ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)

      ‘Change the text of the first text box on the slide.
      ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 2).Value

      Next
      End Sub

  8. nqw1 says:

    Hello and thanks for the script. It would be perfect for my purpose IF I can get it working :) I get error: “run-time error ‘429’: ActiveX component can’t create object”. It refers to line:
    Set OWB = Excel.Application.Workbooks.Open(“C:\list.xlsx”)

    I have changed the file path and checked reference to Excel Objects. What could be causing the error?

Leave a Reply

Your email address will not be published. Required fields are marked *

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>

  • Tags

  • Categories

  • My LinkedIn Profile

    To see my LinkedIn profile, click here:

    Craig Tolley
  • June 2011
    M T W T F S S
    « May   Jul »
     12345
    6789101112
    13141516171819
    20212223242526
    27282930  
  • Meta

  • Top Liked Posts

    Powered by WP Likes

Swedish Greys - a WordPress theme from Nordic Themepark.