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:
- Open a given Excel Document
- For Each used row in column A of sheet 1, create a copy the first slide in the presentation.
- 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 SubPaste 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
Extension 2 – Adding an Image shape based on a path in the spreadsheet
In this example, the title of the image is in column 1 of the spreadsheet, and in column 2 is the filename. This script will bring in the picture to the slide and set it as the background image of the target shape.
The template slide will have a Text Box and a Rectangle shape. The rectangle shape will contain the picture. All pictures must be in the same folder.
Sub CreateSlides()
'Define the folder that contains all of the images. Make sure to include a trailing slash (\)
Dim ImageFolder As String
ImageFolder = "C:\Users\Craig\Pictures\"
'Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open("C:\Users\Craig\Desktop\ImageList.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
'Set the image location of the shape
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(2).Fill.UserPicture (ImageFolder + WS.Cells(i, 2).Value)
Next
End Sub
Reversing the Process – Export Slides to Excel
Again, by request we have the reverse of this process. This routine takes a PowerPoint presentation, and exports any objects that have a text value to an Excel workbook. Each slide is on a different row, and each shape is given a different column. Run from PowerPoint, adding in the Microsoft Excel Objects as before.
Sub CreateWorkbookFromSlides()
On Error Resume Next
' Create the Excel Workbook Object
Dim OWB As Excel.Workbook
Set OWB = Workbooks.Add
Dim CurXLRow As Integer
Dim CurXLCol As Integer
CurXLRow = 1
' Go through each of the slides in the presentation, extracting text for each object
For i = 1 To ActivePresentation.Slides.Count
CurXLCol = 1
For j = 1 To ActivePresentation.Slides(i).Shapes.Count
If ActivePresentation.Slides(i).Shapes(j).HasTextFrame = msoTrue Then
OWB.Worksheets(1).Cells(CurXLRow, CurXLCol).Value = ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Text
CurXLCol = CurXLCol + 1
End If
Next
CurXLRow = CurXLRow + 1
Next
'Prompt for the filename to save as and capture any errors
strFileName = InputBox("Enter the full path to save the file as (e.g C:\MyExtract.xlsx:", "Creating New File...")
If strFileName <> "" Then
OWB.SaveAs strFileName
Else
MsgBox ("Invalid filename. Excel Export not saved")
End If
If Err.Number <> 0 Then
MsgBox ("There was an error saving the file.")
End If
'Close off the workbook when we are finished
OWB.Close
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
It’s my first DAY at vba and I need to get this done. After a few hours searching for that om Google, I started thinking “well, maybe not everything is in Google after all…”
But then Craig was there!
Wonderful job!!!
Craig,
Very nice work. I have been reading into this a little but I am impressed with you as a person too. You have been answering everyone on this forum for 10 years. Color me impressed.
So I know nothing about VBA and I am trying to Help my 5 year old with site words. Like 300 hundred of them that I had in excel.I just want to use the simple version of your script and take my column in excel and create a PowerPoint with 1 word per slide. So applied your code to my PP Project and It worked, Sort of… It got to row 7 and threw an error.
Runtime error ‘-2147188160 (80048240)’;
Slides (Unknown Member) : Invalid request. Clipboard is empty or contains data which may not be pasted here
End or Debug.
Thank you in advanced for any advice you can provide me.
With gratitude,
Jonathan
Hi Jonathan,
Most likely there is something in the Excel data that is not strict text. Could be a hidden character or something. You could sanitise your input file by using the CLEAN function in excel to remove all non-printable characters from a cell value. I would try that first.
If that does not work and you still have issues, let me know and I could have a look at your source file and see if I can see what is going wrong.
Craig
THANK YOU – Easy to create ~400 Slides based on an Excel Column ( I concatenated first/last names in a new column and used that to name everybody’s ‘hobby slide.’
Respectfully,
Mark
Hello Craig,
I am trying to use Extension 2 but this line gives an error
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(2).Fill.UserPicture (ImageFolder + WS.Cells(i, 2).Value)
Thanks in advance
Ahmed
Most likely I would guess that Shapes(2) is not a shape which can accept a picture. Have you used the ListShapes function to check which shapes you are working with? If you can be more specific about the error that you are getting then I may be able to help further.
Craig, this is amazing work and it’s the first time dealing with VBA. I have another question for you pertaining to the codes above. Is there a way to pull specific information from every row but only certain columns? For example, Text Box 1 would refer to Column A, Text Box 2 = Column E, etc. My organization has been using the same slide templates since I have been here but everything has been manually inputted. I would like to automate the process so we don’t have to update 100+ slides weekly.
The excel spreadsheet that we maintain is used for day-to-day operation and tracking, but the bosses above us are only interested in specific information. i.e. “Title” (Column A), “Date Started” (Column B), “Percent Complete” (Column E), and “Remarks” (Column H).
Is this possible? Again, thank you for the easy to follow steps regarding the codes above! Thank you, Craig!
Hi, yes it is possible. The code you need to amend is WS.Cells(i, 1).Value. The 1 is the column number, so A=1, B=2, etc. Simply copy the line (15 in the main example) for each value you need and update the column number.
Hello 2018 and still found this helpful!
I am not a program at all but needed a function like this.
We have our Part number and Quantity on hand in excell. I was able to get them all on slides.
You mention about shapes. I was wondering how I could have an image of the product added to the slide?
I would imagine it would involve a link to picture in a column in excel. The link would reference a folder where the images would be.
How would I write that?
I have just added some example code to the page that will do that for you. Your template will need a shape object – such as a Rectangle, that is the placeholder for the image that you want to show. Hopefully the code makes sense, but let me know if not.
This has been a WONDERFUL tool for me thus far! I have been creating Youtube “Shout out” slideshows by importing my subscriber list and then generating slides. However, once the list reached 750 names or so, it crashes. I am presuming the issue is that my computer is copying and pasting slides quicker than it can paste the content into the slides. I’ve played with different methods to slow the script down, but once I hit about 500 slides, things crash out again. Any ideas? Thanks for this GREAT tool!
Wow that is a lot of slides!! I’ve never tested that many slides!! I would hazard a guess that you hit memory limits – maybe. Could you try breaking it up and doing it in 3 batches of 250?
I tried this code in both windows 10 office 365 and windows 8 office 2013
HI, I have a dump of images ~1000 images/icons along with the keywords/thumbnails on ppt s. While working on on other presentations, i would like to have a search button at RHS Top so that i can search the images by using keyword and i can insert when required. Is it possible?
It sounds like it should be possible. You would need to look into developing a custom ribbon button and form which can do the work. Not something I have ever looked into doing. Good luck though!
Thanks! With a tiny bit of tweaking this was exactly what I needed.
Haha, five years later and this post is still saving people time.
Thanks mate! I was having some trouble executing it in Powerpoint for Mac, then I tired a Windows and it’s all fine. Saved me lots of time! :)
I am having difficulty with the syntax of line three of the Create Slides Module. The following yields a syntax error. What am I doing wrong?
Dim OWB As New Excel.Workbook “C:\Users\gr8yte\Documents\vocabulary med100, 20160126.xls”
Hi,
You can’t create the OWB object and then open the file all on one line. You need to do it as two lines, like this:
Dim OWB As New Excel.Workbook Set OWB = Excel.Application.Workbooks.Open("E:\test, with commas.xlsx")Dear Craig and fellow experts on this page
Thank you for all the advice on this page, unfortunately I’m being a numpty and can’t get it to work, I’ve tried various combinations of above but I’m totally new to VBA, and whilst I’ve self-taught myself a lot of html/php and successfully done one VBA module to export PPT content into an excel sheet, this is proving beyond my skillset at present.
My Objective: Generate a presentation of quotation slides from an excel sheet. Each slide to have the quotation text in the ‘Master Title’ box and then the author in the ‘Sub-Master Title’ box below the former shape.
So far I have
(1) Set up a project folder and put into it
– template document: Quote_Template.ppt this has one slide with correct shape layout
– excel worksheet: Book1.xlsx
– CSV sheet: Book1.CSV this is simply a CSV version of excel sheet
(2) Opened up PPT file, started VBA editor (Alt-F11) – tried to run shape finder
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
BUT IT RESPONDED: Syntax error and throws up this line
‘If ActivePresentation.Slides(1).Shapes.Count = 0 Then
MsgBox (“No shapes on slide 1”)’
(3) Tried to run what I thought was the edited original VBA script but got this syntax error highlighting this code: ‘Dim the Excel objects’
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(C:\Users\toshiba\Dropbox\1 Work\QuoteTest\Book1.xlsx)
‘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(“A60”).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
I’ve been trying to crack this for hours now and I just can’t see where I’m going wrong, although I appreciate to an experienced eye it will be staring me in the face.
Please can you sanity check where I’m going wrong and get me back on the right path.
Huge thanks
Jacqueline
Hi Jacqueline,
This could be a really simple fix. The speech marks in the example have been substituted with a different symbol. Try re-typing all of the speech marks in your code.
Brilliant, thanks Craig – got the List Shapes script to work. Now perservering with the ‘Create Slides’ which isn’t proving as amenable.
Got to this point but have to run out for an appointment. Will return and try again later.
Sub CreateSlides()
‘Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open(“C:\users\toshiba\dropbox\1 work\QuoteTest\Book1.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
Ok, I copied and pasted the code above, it had substituted incorrect apostrophes and speech marks. If I replace all of those it runs fine though. What line are you getting an error on?
Firstly apologies I’ve been away, but I’m back and back on it.
Ran the above again, having replaced all the quote marks and apostrophes, but got Compile Error: User-defined type not defined with ‘OWB As New Excel.Workbook highlighted’ in the background
Apologies – again – sure it’s me doing something a more experienced head would know to do straightaway
Thanks in advance, Jacqueline
I think that sounds like the Excel reference has not been added in. Can you check under Tools –> References and ensure that the Microsoft Excel Objects is checked?
Thanks Craig – you were right I needed to check the Excel within Tools & References – hadn’t realised it wouldn’t carry over from other documents. Need to check each time – will do that in future. Can now get slides to auto-generate from excel which is incredible – thank you so much.
All I need to do now is crack how to get Col A into Shape Number 1; Title 1 and col B into Shape Number 2: Subtitle 2
Almost there… thank you so much for all your help so far. If you can bear with me longer to finish the puzzle I’d truly appreciate it. Will try to crack this final component in the morning with fresh eyes.
If you haven’t already sorted it, then this is simple to do. You just need another line in there to populate the next shape.
‘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
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(2).TextFrame.TextRange.Text = WS.Cells(i, 2).Value
Next
You can repeat this as many times as you like.
Thanks Craig – sorry hadn’t seen your response earlier – sure that will work a treat when I run it on Monday (off to do an air cadet camp all weekend so can’t try earlier). Huge thanks again, Jacqueline
Hi Craig! First of all I have to say your script helped me in my assignment a lot! Thank you so much! Is there additional code you can add to delete the first template slide once the copying of the subsequent slides that I need are done? Thank you!
Great – glad it helped.
Deleting the template at the end can be achieved by adding the following line: ActivePresentation.Slides(1).Delete
Hi Craig,
I’m trying to use this on Excel 14.0 (Mac Excel) and it’s throwing a “run-time error ‘429: ActiveX component can’t create object” for the line Set OWB = Excel….” a similar problem to nqw1. Any thoughts on why it isn’t working?
Hi, I have never tried this on a Mac but it should still work the same. Have you definitely added in the reference to the Excel objects?
Wonderfully simple, thank you for this. Is there a way to run something similar from the Excel VBA side?
You probably can. I’m not exactly sure what you are trying to achieve, but it should work.
Hi Craig,
I just used your macro to generate hundreds of slides at the click of a button… thanks for saving me a whole days work :-)
Just wondering though–is there any way to copy formatting from the Excel file (bold/underline/italics) as well?
I thought this might have worked:
ActivePresentation.Slides.PasteSpecial
…but I’m probably just making a fool of myself by saying that!? :-(
This may be possible, but would probably require some different code to put in the value.
Currently the line which copies the cell text is this:
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value
Note the last little bit, where we read the value of the cell and put it in the text box frame.
There may be a way to copy the whole Cell, formatting and all, and paste into the text frame. I imagine it would look something like this, but I have not tested this at all:
WS.Cells(i, 1).Copy
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Paste
Hi Craig,
That worked great, although it did crash out on with very large numbers of slides (500+)… probably because of all the copy-and-paste operations.
I used you code and added in:
CutCopyMode = False
DoEvents
to try to stop it crashing.
So far, so good :-)
Thank you very much for this.
My question would now be can you do the reverse? So that changes made in the PowerPoint could be reuploaded into an Excel, with each slide corresponding to a row?
Yep, sure is a way to do this. I have included it above in the post in a new section. Let me know how you get on.
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
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.
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
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
Hey Craig, thanks for providing all this information. I tried the macro and had the same problem, but now it works like magic!! The time you put into writing this saved me HOURS of work, thanks for the sacrifice!!
Does this work with excel 2007 as well?
I should think it would, but I don’t have a copy of Excel 2007 to confirm though.
I tried on 2007. It works very well. thanks for sharing this useful code and guide.
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!
Wow Chris! Thanks for the enhancement.
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…
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.
I had the same problem, so I made a hybrid of Chis and Craig’s solutions which seems to work well. It uses Craig’s method of duplicating the slides etc., and Chris addition of the file selection prompt. Just make sure your text boxes are objects 1, 2, 3, 4, 5….. In other words, start a new document, then create the text boxes in order.
Sub CreateSlides()
‘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
‘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 = objWorksheet.Cells(i, 2).Value
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(2).TextFrame.TextRange.Text = objWorksheet.Cells(i, 3).Value
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(3).TextFrame.TextRange.Text = objWorksheet.Cells(i, 4).Value
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(4).TextFrame.TextRange.Text = objWorksheet.Cells(i, 5).Value
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(5).TextFrame.TextRange.Text = objWorksheet.Cells(i, 6).Value
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(6).TextFrame.TextRange.Text = objWorksheet.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
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?
Hi, see above edit to the post.
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!
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.
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 :)
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.
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
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?
It would seem like the Excel DLL file is either not registered properly or is corrupt. What version of Excel are you running?