Replacing text in PowerPoint 2016 using VBA

David Wilson
David Wilson used Ask the Experts™

I have a lot of presentations used as templates, and I have data that I'd like to replace systematically.  For example, if I set the Title property to "Killer Presentation" I want everywhere in my PPT template that has "[Title]" to be replaced with "Killer Presentation."  But I want to be able to use any of the property fields (title, created, etc including custom property fields).

I found a solution that appears to be exactly what I want in the answers to this posting:

Problem is I used this code in a presentation to test, and while it runs, I don't see any results. Maybe this has something to do with the fact that I'm using PPT 2016, but I'm very new to VBA and I don't see where the issue is, and I'm not getting any errors to troubleshoot.

Anyone have any insight into the solution posted by P.Boothroyd in the post linked above?  And if I need to paste the code here, I can do that, if it makes it easier.

Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Senior Technical Consultant at BrightCarbon
That code is written very oddly and is specifically managing the title placeholders of slides. I've modified it to make it more generic and targeted at what you want to achieve.

Note there was an error in the line "If yearFrom  yearTo Then" so I've just commented it out for now.

Option Explicit

' Copy document properties into all slides
' Original Source : (c) 2013, P.Boothroyd for NIS Oskemen
' Modified by : Jamie Garroch of
Dim oSld As Slide

Sub updateProperties()
    Dim oShp As Shape
    Dim propname As String
    Dim thisText As String
    ' parse all slides in the active presentation (document)
    For Each oSld In Application.ActivePresentation.Slides
        ' scan all elements of the slide for textbox with tagged "altText/title" field with "["
        For Each oShp In oSld.Shapes
          With oShp
            If .HasTextFrame Then ' find text boxes, placeholders and shapes that support text
              thisText = .TextFrame.TextRange.Text
              If Left(thisText, 1) = "[" Then
                  Dim sStart, sEnd As Integer
                  ' extract property from between square brackets
                  sStart = 2
                  sEnd = InStr(2, thisText, "]")
                  propname = Trim(Mid(thisText, sStart, sEnd - 2))
                  If oShp.HasTextFrame Then
                    ' set the text to the requested value
                    oShp.TextFrame.TextRange.Text = getProperty(propname, thisText)
                  End If
              End If
            End If
          End With
        Next ' oShp
    Next ' oSld
End Sub

' get the named document property (with optional default)
Function getProperty(propname, Optional def As String) As String
    ' property assigned the default value
    getProperty = def
    Dim found As Boolean
    found = False
    propname = LCase(propname)

    ' copyright is a generated property
    If propname = "copyright" Then
        Dim author As String
        Dim company As String
        Dim yearFrom As String
        Dim yearTo As String

        ' get all appropriate variables
        author = getProperty("author", "")
        company = getProperty("company", "")
        yearFrom = getProperty("created", "")
        yearTo = Format(Now(), "YYYY")

        ' insert copyright symbol
        getProperty = Chr(169) + " "

        ' attach year span for copyright notice
        'If yearFrom  yearTo Then
        '    getProperty = getProperty + yearFrom + "-"
        'End If
        'getProperty = getProperty + yearTo

        ' add the author
        getProperty = getProperty + " " + author

        ' add separator for author/company if both exist
        If Len(author) > 0 And Len(company) > 0 Then
            getProperty = getProperty & ", "
        End If
        getProperty = getProperty & company

        ' processed, so return the value
        found = True
    End If

    ' insert the slide number into the document
    If propname = "page" Then
        getProperty = oSld.SlideNumber
        found = True
    End If

    ' if generated name created return the value
    If found Then GoTo ret

    ' scan for standard MS (file) properties of the named value
    Dim p
    For Each p In Application.ActivePresentation.BuiltInDocumentProperties
        If LCase(p.Name) = propname Then
            getProperty = p.Value
            found = True
            Exit For
        End If
    Next ' p

    ' scan for customised properties of the named value
    If found Then GoTo ret
    For Each p In Application.ActivePresentation.CustomDocumentProperties
        If LCase(p.Name) = propname Then
            getProperty = p.Value
            found = True
            Exit For
        End If
    Next ' p
End Function

Open in new window



Your changes are awesome and now I see results in my presentation, which is fantastic! If I am reading the code correctly, it appears it should be going through all the slides applying the changes.  However, it's only working on one slide. I'll dig into that, but just wanted to share.

And for what it's worth, I'm actually not using the page number and copyright, so I commented that code out.  I probably could have stated that up front, for what it's worth. :)

Jamie GarrochSenior Technical Consultant at BrightCarbon

I didn't test with more than one slide but I have now and it's working for me. I had a title slide with [Title] in the title placeholder, [Category] in the subtitle placeholder, and [myCustomProp] in a text box. This is the line where that starts:
If Left(thisText, 1) = "[" Then

Open in new window

I duplicated the slide and ran the updateProperties Sub and both slides were auto-populated. Note that the way the original code was written, it'll only find your "fields" if they appear at the beginning of the text in whatever object they reside. If the solution works, don't forget to award the points and close the question.


Thanks Jamie!  Very helpful!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial