how can i use mail merge in ppt

mayaz
NewLounger
Posts: 1
Joined: 25 Dec 2021, 17:05

Re: how can i use mail merge in ppt

Post by mayaz »

Dear,
This code is wonderful. I have a query, what if the text (in ppt) is written in more than one taxt box, then it does not work,

Can you do a favour for editing the code for multiple text boxes inside a slide?

Regards
HansV wrote:
06 Feb 2017, 10:23
See the modified workbook and presentation in the zip file.
The workbook now contains a macro

Code: Select all

Sub Merge2PPT()
    Dim pptApp As PowerPoint.Application ' Object
    Dim pptPrs As PowerPoint.Presentation ' Object
    Dim pptSld As PowerPoint.Slide ' Object
    Dim pptShp As PowerPoint.Shape
    Dim strFile As String
    Dim r As Long
    Dim m As Long
    strFile = Application.GetOpenFilename("PowerPoint Presentations (*.pptx),*.pptx", , "Select PowerPoint file")
    If strFile = "False" Then
        Beep
        Exit Sub
    End If
    On Error Resume Next
    Set pptApp = GetObject(Class:="PowerPoint.Application")
    If pptApp Is Nothing Then
        Set pptApp = CreateObject(Class:="PowerPoint.Application")
        If pptApp Is Nothing Then
            Beep
            Exit Sub
        End If
    End If
    On Error GoTo 0 ' ErrHandler
    pptApp.Visible = msoCTrue
    Set pptPrs = pptApp.Presentations.Open(strFile, , , msoFalse)
    m = Range("A" & Rows.Count).End(xlUp).Row
    For r = m To 2 Step -1
        pptPrs.Slides(1).Duplicate
        Set pptSld = pptPrs.Slides(2)
        Set pptShp = pptSld.Shapes(1)
        With pptShp.TextFrame.TextRange
            .Replace "<1>", Range("D" & r).Value
            .Replace "<2>", Range("A" & r).Value
            .Replace "<3>", Range("C" & r).Value
            .Replace "<4>", Range("B" & r).Value
        End With
    Next r
    pptPrs.Slides(1).Delete
    pptPrs.NewWindow
    With pptApp.FileDialog(msoFileDialogSaveAs)
        .InitialFileName = pptPrs.Path & "\New.pptx"
        If .Show Then .Execute
    End With
ExitHandler:
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
This macro will prompt you to select the presentation with the template slide; at the end it will prompt you to save the completed presentation under another name.
I added placeholders <1>, <2>, ... for the name etc. in the slide; the code replaces these with values from the worksheet.

User avatar
HansV
Administrator
Posts: 73830
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: how can i use mail merge in ppt

Post by HansV »

Welcome to Eileen's Lounge!

Could you attach a PowerPoint presentation with an example of the slide you want to use?
Regards,
Hans

mayaz
NewLounger
Posts: 1
Joined: 25 Dec 2021, 17:05

Re: how can i use mail merge in ppt

Post by mayaz »

Thanks HansV,

I have attached the sample ppt file. Basically, I have to use two text boxes inside a single slide, in which there are either single/multiple values to be replaced using excel.
You do not have the required permissions to view the files attached to this post.
Last edited by mayaz on 27 Dec 2021, 15:38, edited 1 time in total.

User avatar
HansV
Administrator
Posts: 73830
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: how can i use mail merge in ppt

Post by HansV »

Thank you. Here is a modified macro:

Code: Select all

Sub Merge2PPT()
    Dim pptApp As Object
    Dim pptPrs As Object
    Dim pptSld As Object
    Dim pptShp As Object
    Dim strFile As String
    Dim r As Long
    Dim m As Long
    ' Prompt for source presentstion
    strFile = Application.GetOpenFilename("PowerPoint Presentations (*.pptx),*.pptx", , "Select PowerPoint file")
    If strFile = "False" Then
        Beep
        Exit Sub
    End If
    ' Get or stsrt PowerPoint
    On Error Resume Next
    Set pptApp = GetObject(Class:="PowerPoint.Application")
    If pptApp Is Nothing Then
        Set pptApp = CreateObject(Class:="PowerPoint.Application")
        If pptApp Is Nothing Then
            Beep
            Exit Sub
        End If
    End If
    On Error GoTo ErrHandler
    pptApp.Visible = msoCTrue
    ' Open presentation
    Set pptPrs = pptApp.Presentations.Open(strFile, , , msoFalse)
    ' Last used row
    m = Range("A" & Rows.Count).End(xlUp).Row
    ' Loop through the rows
    For r = m To 2 Step -1
        ' Copy first slide
        pptPrs.Slides(1).Duplicate
        ' Refer to new slide
        Set pptSld = pptPrs.Slides(2)
        ' Three placeholders on first shape
        Set pptShp = pptSld.Shapes(1)
        With pptShp.TextFrame.TextRange
            .Replace "<1>", Range("A" & r).Value
            .Replace "<2>", Range("B" & r).Value
            .Replace "<3>", Range("C" & r).Value
        End With
        ' Two placeholders on second shape
        Set pptShp = pptSld.Shapes(2)
        With pptShp.TextFrame.TextRange
            .Replace "<4>", Range("D" & r).Value
            .Replace "<5>", Range("E" & r).Value
        End With
    Next r
    ' Delete the first slide
    pptPrs.Slides(1).Delete
    ' Show presentation in a window
    pptPrs.NewWindow
    ' Prompt to save the presentation with a new name
    With pptApp.FileDialog(msoFileDialogSaveAs)
        .InitialFileName = pptPrs.Path & "\New.pptx"
        If .Show Then .Execute
    End With

ExitHandler:
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
I have attached a sample workbook with some dummy data to merge, and with the macro.

PPT_Demo.xlsm
You do not have the required permissions to view the files attached to this post.
Regards,
Hans

Miran
NewLounger
Posts: 2
Joined: 17 Jan 2022, 06:49

Re: how can i use mail merge in ppt

Post by Miran »

Can you help modifying the code for this template and data sheet? I have tried the last code but it didn't work....
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 73830
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: how can i use mail merge in ppt

Post by HansV »

Welcome to Eileen's Lounge!

All tables on the slide were named "Table 9", making it impossible to distinguish them. I have given them unique names.
Moreover, you didn't save the presentation at the end.
See the attached versions.

11th MAIN List for Merge.xlsm
New Microsoft PowerPoint Presentation.pptx
You do not have the required permissions to view the files attached to this post.
Regards,
Hans

Miran
NewLounger
Posts: 2
Joined: 17 Jan 2022, 06:49

Re: how can i use mail merge in ppt

Post by Miran »

Hi Hans,

It worked.... Thanks a ton man....