Mail Merge in PowerPoint using VBA, Excel Version.

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:

Simple Mail Merge in PowerPoint using VBA

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!