A simple Mail Merge in PowerPoint
As you can see in the above image we have merged employee data (id, first name, last name and a picture) stored in Excel into a slide in PowerPoint.
In the previous post:
we did a merge using PowerPoint and a SQL Server database as the data source.
But what if you want your data to be stored in Excel not in a SQL database?
In this post we will see how PowerPoint can merge data (get data) from Excel.
First we need the data in Excel, for this example we’ll use 4 columns as
Column A: Id.
It’s a number 1, 2, 3,…
Column B: First Name.
Like “Sam”, “John”, …
Column C: Last Name.
Like “Smith”, “Doe”, …
Column D: Picture.
There are two options to put a text or put an image
Merging text like Id, First Name and Last Name is the easy part, merging a picture or photograph is a little tricky but can be done:
A) The easiest way to do it is using a link to the image file, like you can see in the following image, we put the picture file location in a column called “Picture”.
B) Inserting the image directly into Excel. It’s a little more complicated.
These pictures have the property “Move and size with cells” as you can see in the image below, see the yellow mark.
This setting makes the picture stay with a cell when the cell moves (for example, when it is sorted) and to resize the picture when the cell height and width changes.
Let’s begin.
In the first case “A)”, you need to follow these steps:
1. Add a reference to Excel. In Tools\References mark with a check the library called “Microsoft Excel 15.0 Object Library”
2. Open the Excel file. In this case the file name is Employees.xlsx and it’s located in “C:\”.
Dim XL As Excel.Workbook Set XL = Excel.Application.Workbooks.Open("c:\Employees.xlsx")
3. We need a loop to cycle the rows with data.
- If we know how many rows with data we have in Excel, we could use a For…Next loop. Like this:
Dim x As Long 'We know there are exactly 50 rows and they start in row number 2 For x = 2 to 51 'Here goes the code that applies to every row. Next x
- If we don’t know how many rows with data we have in Excel, we better use a While loop. Like this:
Dim x As Long Dim Id as Long 'We don't know how many rows to iterate so we ask if the Id column has a number greater than zero. x = 2 'Data starts in row number 2 Id = XL.Sheets(1).Cells(x, 1) 'Read the first Id for the first row Do While x > 0 'Here goes the code that applies to every row. 'This code needs to be at the end of the loop 'Reads the next row x = x + 1 'Increase the row counter Id = XL.Sheets(1).Cells(x, 1) Loop
4. Inside the loop we need to read the columns A, B C, D basically Id, First Name, Last Name and the Picture.
Id = XL.Sheets(1).Cells(x, 1) FirstName = XL.Sheets(1).Cells(x, 2) LastName = XL.Sheets(1).Cells(x, 3) PictureFileName = XL.Sheets(1).Cells(x,4)
A complete listing is included at the end of this post that uses the “picture inside Excel”.
For using a link to the picture’s file name load the picture into a shape like this:
Dim sh as Shape Set sh = ActivePresentation.Slides(1).Shapes.AddPicture(PictureFileName, msoFalse, msoTrue, 190, 50 + ((i - 1) * 150))
Picture inside Excel.
If the picture is case “B)” then is inside excel so we need to extract it. There are two ways the easy way and the long way.
Easy way
Using the method CopyPicture like this:
XL.Sheets(1).Cells(2,4).CopyPicture
It copies to the Clipboard the picture located in cell row = 2, column = 4. Then we paste it with Shapes.Paste.
Long Way
First we need to locate the picture that corresponds to the row number inside the loop. For the first row we need to find its picture, for second row, etc.
We need to iterate all the shapes in the Shapes collection like this:
For Each Sh In XL.Sheets(1).Shapes Next
Inside the previous loop we need to ask if the Shape is the one we want.
Example 1. Using the Property Shape.TopLeftCell.Row
Shape.TopLeftCell.Row = x
Listing 2.1
Dim Sh as Shape With Worksheets("Sheet1") For Each Sh In .Shapes If Sh.TopLeftCell.Row = x Then If Sh.Type = msoPicture Then End If End If Next End With
Example 2. Intersecting two ranges. Application.Intersect(range1, range2)
Application.Intersect(Sh.TopLeftCell, XL.Sheets(1).Range(Cells(x, 4), Cells(x, 4)))
Listing 2.1
Dim Sh as Shape With Worksheets("Sheet1") For Each Sh In .Shapes If Not Application.Intersect(Sh.TopLeftCell, XL.Sheets(1).Range(Cells(x, 4), Cells(x, 4))) Is Nothing Then If Sh.Type = msoPicture Then End If Next End With
Example 3. Using Address Property of the Range Object.
Sh.TopLeftCell.Address = XL.Sheets(1).Range(Cells(x, 4), Cells(x, 4)).Address
“x” represents the row and “4” represents the column.
There we have 3 ways to find the correct picture for the row. All of them iterates the whole Shapes collection for each row in Excel. If you happen to know a better way to do this just let me know.
5. We need to copy the picture from Excel to PowerPoint. We are going to use the Clipboard. For Excel version 2010 and 2013 use the CopyPicture method from the Shape object.
Shape.CopyPicture
For previous versions you need to call the API functions or use the object DataObject, you will need a reference to the library “Microsoft Forms 2.0 Object Library” here is the link http://www.cpearson.com/excel/Clipboard.aspx
6. Paste the Clipboard into a PowerPoint Shape. Use the Paste method from the Shapes collection. Returns a ShapeRange object.
Dim Sr as ShapeRange Set Sr = ActivePresentation.Slides(1).Shapes.Paste 'We can move the picture to the desired location Sr(1).Left = 10 Sr(1).Top = 10
Complete Listing:
Sub MailMergeWithExcel() 'Don't forget to reference "Microsoft Excel 15.0 Object Library" Dim XL As Excel.Workbook Set XL = Excel.Application.Workbooks.Open("c:\Users\Daniel\Desktop\Employees.xlsx") Dim Id As Long Dim FirstName As String Dim LastName As String Dim x As Long Dim Sr As ShapeRange 'first row is the header: id, first name, last name, picture 'second row is where data starts x = 2 Id = XL.Sheets(1).Cells(x, 1) Do While Id > 0 'Get employee info from excel FirstName = XL.Sheets(1).Cells(x, 2) LastName = XL.Sheets(1).Cells(x, 3) 'Add employee info from excel Set sh = ActivePresentation.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 10 + ((x - 1) * 100), 145, 100) sh.TextFrame.TextRange.Font.Size = 14 sh.TextFrame.TextRange.Text = "First Name : " & Trim(FirstName) & vbNewLine & _ "Last Name: " & Trim(LastName) & vbNewLine & _ "Id : " & Right("00000" & Trim(CStr(Id)), 5) 'Copy the picture in Excel to the clipboard XL.Sheets(1).Cells(x, 4).CopyPicture 'Paste the picture into a shape Set Sr = ActivePresentation.Slides(1).Shapes.Paste Sr(1).Left = 200 Sr(1).Top = (x - 1) * 100 'Next row x = x + 1 Id = XL.Sheets(1).Cells(x, 1) Loop 'Clean up XL.Close Set XL = Nothing End Sub
Notes:
This is a simple example to merge data from Excel into PowerPoint and avoid typing all over again, also explores two ways to merge a picture from Excel.
Combine this with the code in the previous post, mentioned at the beginning of this post, to make a complete solution.
PowerPoint doesn’t have a mail merge option yet. At the time of this writing we are in version 2013.
Update: The following code is when you need to create one slide for every row in Excel:
Sub MailMergeWithExcel() 'Don’t forget to reference “Microsoft Excel 15.0 Object Library” Dim XL As Excel.Workbook Set XL = Excel.Application.Workbooks.Open("C:\Users\jodi.dunfield\Documents\Employees2.xlsx") Dim Id As Long Dim INumber As String Dim Odate As Date Dim Summary As String Dim Duration As Long Dim Detection As String Dim x As Long Dim Sr As ShapeRange 'Remove Slides RemoveSlides 'first row is the header: Number, Odate, Summary, Duration, Detection 'second row is where data starts x = 2 Id = XL.Sheets(1).Cells(x, 1) Do While Id > 0 'Add one slide AddSlides 'Get incident info from excel INumber = XL.Sheets(1).Cells(x, 2) Odate = XL.Sheets(1).Cells(x, 3) Summary = XL.Sheets(1).Cells(x, 4) Duration = XL.Sheets(1).Cells(x, 5) Detection = XL.Sheets(1).Cells(x, 6) 'Add incident info from excel 'This line has a variable positioning of the text in the vertical axis (the 3 original records appear one below the other) that's why I used an offset 'In 10 + ((x - 1) * 100) 'Set sh = ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 10 + ((x - 1) * 100), 145, 100) 'In this line I set the vertical position in 10. You can set the number 10 to whatever position you require. Set sh = ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 10, 145, 100) sh.TextFrame.TextRange.Font.Size = 14 sh.TextFrame.TextRange.Text = "INumber: " & Trim(INumber) & vbNewLine & _ "Odate: " & Trim(Odate) & vbNewLine & _ "Summary: " & Trim(Summary) & vbNewLine & _ "Duration: " & Trim(Duration) & vbNewLine & _ "Detection: " & Trim(Detection) & vbNewLine & _ "Id : " & Right("00000" & Trim(CStr(Id)), 5) 'Next Row x = x + 1 Id = XL.Sheets(1).Cells(x, 1) Loop 'Clean up XL.Close Set XL = Nothing End Sub Sub RemoveSlides() Dim Pre As Presentation Dim x As Long Set Pre = ActivePresentation For x = Pre.Slides.Count To 1 Step -1 Pre.Slides(x).Delete Next x End Sub Sub AddSlides() Dim Pre As Presentation Dim Sld As Slide Set Pre = ActivePresentation Set Sld = Pre.Slides.Add(Pre.Slides.Count + 1, ppLayoutBlank) Pre.Slides(Pre.Slides.Count).Select End Sub
Troubleshooting.
As pointed in the comments you get the error: “Compile error: User-defined type not defined”.
The problem here is that there is a data type the compiler doesn’t know about it. Examples of simple types are integer, string, date, object, etc.
You can create your own types too but here the problem is most likely one of the Excel’s objects like this line of code:
Dim XL As Excel.Workbook
We are creating a new variable called XL and its data type is Excel.Workbook if you don’t set the reference to the object library that contains that type then at run time it will throw an error that in other words it says “I don’t know that data type so I can not create a variable with that type”.
The following images show what happens when I run code without the correct “reference”:
The message is in spanish (sorry pals) but it says the same.
What you can see in that image is that remarked text in blue is the line with the error. (It is not selected by me)
And this is what happens when you click OK.
As you can see in yellow is the line the compiler is interrupted (or step in) and you can see the line with the error it still remarked in blue.
So the error is shown remarked in blue to let you know, hey that’s the error, do something about it.
The previous error can be corrected going to the menu and click on Tools then on References and select the correct library you need. In this case is “Microsoft Excel 15.0 Object Library”.
Hope this helps.
UPDATE 2015/07/10
Answer to Danni Schroeder question:
Solution for textboxes reuse. First column in Excel go into Textbox 1 and Second column from Excel into Textbox 2, and so on.
The following code assumes that you have enough slides, one for each row. Also each slide has 2 textboxes already there and the exact position of the textboxes is 167.75 for the first textbox and 306 for the second one. Those are the default positions for “new slide: Title Slide”.
If your textboxes are in a different place you can use this line to know the exact position:
MsgBox ActiveWindow.Selection.SlideRange.Shapes(i).Top
You can also find the textboxes looking their content, you can say: if the textbox = “something” then…
Sub MailMergeWithExcel() 'Don't forget to reference "Microsoft Excel 15.0 Object Library" Dim XL As Excel.Workbook Set XL = Excel.Application.Workbooks.Open("c:\Users\Daniel\Desktop\Libro1.xlsx") Dim ColumnA As String Dim ColumnB As String Dim x As Long Dim i As Long 'this is for the slides part starts in slide number 1 Dim mySlide As Long mySlide = 1 'first row is the header: ColumnA, ColumnB 'second row is where data starts x = 2 Do While XL.Sheets(1).Cells(x, 1) <> "" 'Get row from excel ColumnA = XL.Sheets(1).Cells(x, 1) ColumnB = XL.Sheets(1).Cells(x, 2) 'Add row from excel into Slide If ActivePresentation.Slides.Count >= mySlide Then 'select slide ActivePresentation.Slides(mySlide).Select 'fill data in textboxes For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count() 'uncomment the following line to know the top position of the shape 'MsgBox ActiveWindow.Selection.SlideRange.Shapes(i).Top Select Case ActiveWindow.Selection.SlideRange.Shapes(i).Top Case 167.75 'first textbox ActiveWindow.Selection.SlideRange.Shapes(i).TextFrame.TextRange.Text = ColumnA Case 306 'second textbox ActiveWindow.Selection.SlideRange.Shapes(i).TextFrame.TextRange.Text = ColumnB End Select Next i Else 'I have more rows in Excel than slides in this presentation MsgBox "I have more rows in Excel than slides in this presentation" 'leave Exit Do End If 'Next row x = x + 1 'next slide mySlide = mySlide + 1 Loop 'Clean up XL.Close Set XL = Nothing End Sub
This is the Excel file (Libro1.xlsx):
This is before execution of the script
That’s the end result. 3 Slides, 3 Rows in Excel.
And… That’s it!
This would be really helpful if I can get it to work. I’m in PowerPoint 2013 and I have gone to Tools, References and checked Microsoft Office 15.0 Object Library for references. When I compile the code above it throws a compile error at the first line of “Dim DL As Excel.Workbook” stating User-defined type not defined. I thought that was handled in the references. Is there something more I need to do? Thank you.
I think Microsoft Office 15.0 Object Library is already checked.
You need to check Microsoft Excel 15.0 Object Library
EXCEL is the library you need to check.
By the way if the VBA environment doesn’t show a blank page to write code, you need to Add Module
Don’t forget to put the code inside a “Sub” like in the example otherwise when you run it, it will ask you for name the macro.
I just checked this works in PowerPoint 2013 again.
When I run this its great however, it puts all of the data from the rows into one slide, instead of opening a new slide for each row. Here’s the code:
Sub MailMergeWithExcel()
‘Don’t forget to reference “Microsoft Excel 15.0 Object Library”
Dim XL As Excel.Workbook
Set XL = Excel.Application.Workbooks.Open(“C:\Users\jodi.dunfield\Documents\Employees2.xlsx”)
Dim Id As Long
Dim INumber As String
Dim Odate As Date
Dim Summary As String
Dim Duration As Long
Dim Detection As String
Dim x As Long
Dim Sr As ShapeRange
‘first row is the header: Number, Odate, Summary, Duration, Detection
‘second row is where data starts
x = 2
Id = XL.Sheets(1).Cells(x, 1)
Do While Id > 0
‘Get incident info from excel
INumber = XL.Sheets(1).Cells(x, 2)
Odate = XL.Sheets(1).Cells(x, 3)
Summary = XL.Sheets(1).Cells(x, 4)
Duration = XL.Sheets(1).Cells(x, 5)
Detection = XL.Sheets(1).Cells(x, 6)
‘Add incident info from excel
Set sh = ActivePresentation.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 10 + ((x – 1) * 100), 145, 100)
sh.TextFrame.TextRange.Font.Size = 14
sh.TextFrame.TextRange.Text = “INumber: ” & Trim(INumber) & vbNewLine & _
“Odate: ” & Trim(Odate) & vbNewLine & _
“Summary: ” & Trim(Summary) & vbNewLine & _
“Duration: ” & Trim(Duration) & vbNewLine & _
“Detection: ” & Trim(Detection) & vbNewLine & _
“Id : ” & Right(“00000” & Trim(CStr(Id)), 5)
‘Next row
x = x + 1
Id = XL.Sheets(1).Cells(x, 1)
Loop
‘Clean up
XL.Close
Set XL = Nothing
End Sub
To open a new slide follow my other post
In that post I add a new slide every 3 records (to show 3 records in a slide) but you can change that to do it every 1 record.
First I calculate how many slides I need (divide record number / number of records by slide) and then I create the slides before I put data on each slide.
‘Add slides needed.
Dim NumSlides As Long
‘We are going to use 3 records by slide, that’s why we use 3 in the following code.
NumSlides = Int(Rs.RecordCount / 3)
‘Add 1 if remainder of division greater than zero
If Rs.RecordCount Mod 3 > 0 Then
NumSlides = NumSlides + 1
End If
Dim num As Long
For num = 1 To NumSlides
AddSlides
Next num
‘AddSlides is a subrutine that add a new slide to the presentation.
Sub AddSlides()
Dim Pre As Presentation
Dim Sld As Slide
Set Pre = ActivePresentation
Set Sld = Pre.Slides.Add(Pre.Slides.Count + 1, ppLayoutBlank)
End Sub
Follow that example, it also deletes all the slides before creating them because if you run this code many times you will end up with a lot of slides.
Hope this helps and happy coding.
This is the code you need to use to create one record in Excel equals one slide in PowerPoint.
Sub MailMergeWithExcel()
‘Don’t forget to reference “Microsoft Excel 15.0 Object Library”
Dim XL As Excel.Workbook
Set XL = Excel.Application.Workbooks.Open(“C:\Users\jodi.dunfield\Documents\Employees2.xlsx”)
Dim Id As Long
Dim INumber As String
Dim Odate As Date
Dim Summary As String
Dim Duration As Long
Dim Detection As String
Dim x As Long
Dim Sr As ShapeRange
‘Remove Slides
RemoveSlides
‘first row is the header: Number, Odate, Summary, Duration, Detection
‘second row is where data starts
x = 2
Id = XL.Sheets(1).Cells(x, 1)
Do While Id > 0
‘Add one slide
AddSlides
‘Get incident info from excel
INumber = XL.Sheets(1).Cells(x, 2)
Odate = XL.Sheets(1).Cells(x, 3)
Summary = XL.Sheets(1).Cells(x, 4)
Duration = XL.Sheets(1).Cells(x, 5)
Detection = XL.Sheets(1).Cells(x, 6)
‘Add incident info from excel
‘This line has a variable positioning of the text in the vertical axis (the 3 original records appear one below the other) that’s why I used an offset
‘In 10 + ((x – 1) * 100)
‘Set sh = ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 10 + ((x – 1) * 100), 145, 100)
‘In this line I set the vertical position in 10. You can set the number 10 to whatever position you require.
Set sh = ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 10, 145, 100)
sh.TextFrame.TextRange.Font.Size = 14
sh.TextFrame.TextRange.Text = “INumber: ” & Trim(INumber) & vbNewLine & _
“Odate: ” & Trim(Odate) & vbNewLine & _
“Summary: ” & Trim(Summary) & vbNewLine & _
“Duration: ” & Trim(Duration) & vbNewLine & _
“Detection: ” & Trim(Detection) & vbNewLine & _
“Id : ” & Right(“00000” & Trim(CStr(Id)), 5)
‘Next Row
x = x + 1
Id = XL.Sheets(1).Cells(x, 1)
Loop
‘Clean up
XL.Close
Set XL = Nothing
End Sub
Sub RemoveSlides()
Dim Pre As Presentation
Dim x As Long
Set Pre = ActivePresentation
For x = Pre.Slides.Count To 1 Step -1
Pre.Slides(x).Delete
Next x
End Sub
Sub AddSlides()
Dim Pre As Presentation
Dim Sld As Slide
Set Pre = ActivePresentation
Set Sld = Pre.Slides.Add(Pre.Slides.Count + 1, ppLayoutBlank)
Pre.Slides(Pre.Slides.Count).Select
End Sub
Any help possible with this issue?
I have followed the example, set the references as Microsoft Excel 15.0 Object Library. But when I go to run the example get the Error:
“Compile error: User-defined type not defined”
It is pointing at the line:
Sub MailMergeWithExcel()
Thanks
I added more text to the post. Maybe that what is happening to you but you said you have the correct reference so I can only guess what the problem is. Maybe if you submit more code for instance the code inside your Sub. Sorry for the delay.
Thanks for this!
As a complete beginner to any type or coding this did take me a few tries but I now have managed to get each row of information on a new slide. I was wondering though if I can I insert the text into text boxes that are already present in my slide, rather than it creating a new text box?
You can reuse your textboxes.
First you need to know how many textboxes you have in the active slide
The following magic words do that
ActiveWindow.Selection.SlideRange.Shapes.Count()
That spell returns the number of textboxes in the active slide
Then you need to traverse the collection of textboxes with a For…Next loop
And finally you can change the text to whatever your heart wants.
ActiveWindow.Selection.SlideRange.Shapes(x).TextFrame.TextRange.Text = "Test"
In the previous hocus pocus I change all the textboxes to the word “Test”.
Here is a complete example:
Sub Test()
MsgBox ActiveWindow.Selection.SlideRange.Shapes.Count()
Dim x As Long
For x = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count()
ActiveWindow.Selection.SlideRange.Shapes(x).TextFrame.TextRange.Text = "Test"
Next x
End Sub
Thanks for this again Daniel.
Sorry to be even more of a pain but if I want my first column of data to go into textbox 1 and then the next column of data to go into textbox 2 and so on, how do I alter the example to make this work?
I updated the post, I wrote a complete solution for your problem. You are not a pain, you are pushing me to learn more and at the same time it could help other people too.
Happy coding!!!
very nice share.
i have some problem here. what u wrote there just did well to the result. but i want to add more step
i have a one slide (as template), it contain text box. i wanna replace the text in the box with the content in excel. so the step i did was duplicate template slide, go to previous slide, replace text i wanted, go to next slide, duplicate…etc
but when i try to gather script form other site by googling, it is not work well. can u figure it out? thanks for ur attention
Hi, I don’t understand the final sentence about gather script. Can you explain it again?
Hi
I have played with this for ages and as I know nothing about coding I am obviously struggling. I am trying to use it to create party invitations that have been done in power point and just want to put a different name in each. I can get the macro to run but it doesn’t put anything in (not that I can see anyway). Do I need a specific text box in the correct location and if i do how do i tell the code where it is and where to put the name. Any help appreciated before I go mad. Cheers in advance.
If I wanted to duplicate the initial slide multiple times would I delete this bit
Sub RemoveSlides()
Dim Pre As Presentation
Dim x As Long
Set Pre = ActivePresentation
For x = Pre.Slides.Count To 1 Step -1
Pre.Slides(x).Delete
Next x
End Sub
But then how do I change this to copy the initial slide each time? Tried so many times but every time it doesn’t work
Sub AddSlides()
Dim Pre As Presentation
Dim Sld As Slide
Set Pre = ActivePresentation
Set Sld = Pre.Slides.Add(Pre.Slides.Count + 1, ppLayoutBlank)
Pre.Slides(Pre.Slides.Count).Select
End Sub
Any way to reuse the image and replace that?