Today I would like to present a possibility to fill pre-defined text fields in a Powerpoint slides with the entries of a cell in a Excel spreadsheet. As I got the basic idea from a website written in English, I also write this post in English.
The basic idea is that the data of each row in the Excel spreadsheet is copied on a separate slide in Powerpoint. The VBA macro that can be found at the website linked above does this already for one column. I only extended the code by the possibility to copy more data of a row and to assign an Identifier to each column.
Therefore, I do not only paste the code, but also upload example files (one Excel spreadsheet and one Powerpoint file - see end of this post at the very very bottom).
The files and the code work with Excel 2010 and Powerpoint 2010. The VBA code is a macro for Powerpoint, not for Excel (hence, the ppt file contains the code). You might have to add Microsoft Excel XX Object Library, so that it works.
Sub CreateSlides()
'*** Original Sourcecode taken from http://superuser.com/questions/323408/excel-data-into-powerpoint-slides ***
'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
Dim sCurrentText As String
Dim sIdentifier As String
Dim oSl As Slide
Dim oSh As Shape
Set WS = OWB.Worksheets(1)
Dim i As Long
'Loop through each used row in Column A
For i = 3 To WS.Range("A65536").End(xlUp).Row
Debug.Print "Bin hier"
'Copy the first slide and paste at the end of the presentation
ActivePresentation.Slides(1).Copy
ActivePresentation.Slides.Paste
Set oSl = ActivePresentation.Slides(ActivePresentation.Slides.Count)
For c = 1 To 3
sCurrentText = WS.Cells(i, c).Value
sIdentifier = WS.Cells(2, c).Value
' find each shape with sIdentifier of the current column (e.g. "field1~", "field2~", and so on) in text, replace it with value from worksheet
For Each oSh In oSl.Shapes
' Make sure the shape can hold text and if is, that it IS holding text
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
' it's got text, do the replace
With oSh.TextFrame.TextRange
.Replace sIdentifier, sCurrentText
End With
End If
End If
Next
Next
Next
ActiveWorkbook.Close
End Sub
Of course, I do not take any responsibility from whatever damage might happen by using the code, the Powerpoint or the Excel file. Everything you do, you do at your own risk.
