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

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

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

  1. Satya says:

    Does this work with excel 2007 as well?

  2. 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!

  3. 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?

  4. 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.

  5. 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 :)

  6. 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

  7. 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.