38

How can I insert a document property (e.g. the author's name) in a slide in PowerPoint 2007? I know this can be done in Microsoft Word, but I can't find how to do it in PowerPoint.

(The idea is that with a document property it is easy to change e.g. the content of the footer in all the slides, even if you use different master pages. If there is a different solution, that would be fine as well.)

7 Answers 7

23

While Word can do this, PowerPoint can't. AFAIK, you can have document properties in PPT, but you cannot insert them on a slide. The only updating field available for PowerPoint is the date and slide number. Anyway, there could be some workaround in VBA to achieve this. You can ask this on Stackoverflow to take your chance.

1
7

Just wrote a subroutine to put named properties into tagged text objects on all slides.

To put a file property onto slide(s). Create a textbox to hold the string. In the properties/Alt Text put the property name into square brackets.

Then execute the macro updateProperties().

i.e. [title] - would allow the document title to be updated on multiple

Two special tags have been written:

  • [copyright] would insert a copyright string, i.e. © 1998-2013 P.Boothroyd, NIS Oskemen
  • [page] would insert the slide number from the editor tab
  • ' Copy document properties into all slides
    ' (c) 2013, P.Boothroyd for NIS Oskemen
    Dim processPage As Slide
    
    Sub updateProperties()
        Dim page As Slide
        Dim propname As String
        ' parse all slides in the active presentation (document)
        For Each processPage In Application.ActivePresentation.Slides
            ' scan all elements of page for textbox with tagged "altText/title" field with "["
            For Each obj In processPage.Shapes
                If Left(obj.Title, 1) = "[" Then
                    Dim sStart, sEnd As Integer
                    ' extract property from between square brackets
                    sStart = 2
                    sEnd = InStr(2, obj.Title, "]")
                    propname = Trim(Mid(obj.Title, sStart, sEnd - 2))
                    If obj.Type = msoTextBox Then
                        ' set the text box to the requested value
                        obj.TextFrame.TextRange.Text = getProperty(propname, obj.TextFrame.TextRange.Text)
                    End If
                End If
            Next ' obj
        Next ' page
    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 = processPage.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
        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
    ret:
    End Function
    
    1

    A workaround is to use custom properties that you can easily "Go To" (no need to wade through slides).

    From http://msdn.itags.org/powerpoint/4426/ :

    1. Select shape or text that you want to set a bookmark to.
    2. Select File | Properties... and activate the Custom tab.
    3. Type a name for the bookmark.
    4. Tick 'Link to content'. The value that is listed in the adjacent dropdown box when you tick 'Link to content' is a reference to your selection.
    5. Click Add.
    6. Click OK to close the Properties dialog.

    Now that you have created a bookmark, you can jump to it as follows:
    1. Select Edit | Goto Property...
    2. Click the Property name from the dialog (this is the name you gave to the bookmark).
    3. Click on Go to.

    The "Go To" dialog presents you a list of bookmarks you can double-click, and goes to your favorite textboxes, ready to be edited / pasted to.

    1

    The easiest way to do this in Powerpoint (at least for values that will appear on every slide) is to edit the slide master. Put the author name there.

    (A possible reason that Word lets you, and none of the others do, is that the various teams at Microsoft rarely talk to each other...)

    1
    • 1
      See the second paragraph in my question: '... even if you use different master pages...' Jun 12, 2012 at 10:09
    1

    Update for handle code with ppt 2019: I changed the for-next routine a Little bit, the cause is that it easier for a front end user to change the "alternativetext" by right mouse button:

        For Each ShapeObj In processPage.Shapes
             If Left(ShapeObj.AlternativeText, 1) = "[" Then
            'If Left(ShapeObj.Title, 1) = "[" Then
                Dim sStart, sEnd As Integer
                ' extract property from between square brackets
                sStart = 2
                'sEnd = InStr(2, ShapeObj.Title, "]")
                sEnd = InStr(2, ShapeObj.AlternativeText, "]")
                'propname = Trim(Mid(ShapeObj.Title, sStart, sEnd - 2))
                propname = Trim(Mid(ShapeObj.AlternativeText, sStart, sEnd - 2))
                    ShapeObj.TextFrame.TextRange.Text = getProperty(propname, ShapeObj.TextFrame.TextRange.Text)
    
            End If
        Next ' obj
    
    0

    I updated the subroutine a bit myself so that it handles my use case: I needed to insert several custom properties in the same text box, and 1 text box per property couldn't work for me. Here is my updated code if someone needs it:

    Sub updateProperties()
        Dim page As Slide
        Dim propname, propvalue As String
        ' parse all slides in the active presentation (document)
        For Each processPage In Application.ActivePresentation.Slides
            ' scan all elements of page for textbox with tagged "altText/title" field with "[CustomProperty]"
            For Each ShapeObj In processPage.Shapes
                If ShapeObj.AlternativeText = "[CustomProperty]" Then
                    Dim sStart, sEnd, test As Integer
                    Dim before, after As String
                    sStart = 1
                    Do While True
                        ' Look for properties in text
                        sStart = InStr(sStart, ShapeObj.TextFrame.TextRange.Text, "[")
                        ' Exit loop when no more properties
                        If sStart = 0 Then
                            Exit Do
                        End If
                        sEnd = InStr(sStart, ShapeObj.TextFrame.TextRange.Text, "]")
                        ' If there is no end, then exit loop
                        If sEnd = 0 Then
                            Exit Do
                        End If
                        ' Save text before and after property
                        before = Mid(ShapeObj.TextFrame.TextRange.Text, 1, sStart - 1)
                        after = Mid(ShapeObj.TextFrame.TextRange.Text, sEnd + 1)
                        ' Get property name
                        propname = Mid(ShapeObj.TextFrame.TextRange.Text, sStart + 1, sEnd - sStart - 1)
                        ' Retrieve the value if it exists
                        propvalue = getProperty(propname)
                        ' If property doesn't exist or we increment sStart to skip this property on next loop
                        If propvalue = "" Then
                            sStart = sStart + 1
                        Else
                            ' Replace text
                            ShapeObj.TextFrame.TextRange.Text = before + getProperty(propname, ShapeObj.TextFrame.TextRange.Text) + after
                        End If
                    Loop
                End If
            Next ' obj
        Next ' page
    End Sub
    

    To use it, change the AltText to "[CustomProperty]", then the subroutine will replace all [property] in the text box by their value.

    This could probably be better coded using regex...

    0
    Sub UpdateDocPropValue()
    
        Dim docProps As Office.DocumentProperties
        Dim docProp As Office.DocumentProperty
        Dim page As Slide
        
        Set docProps = Application.ActivePresentation.CustomDocumentProperties
           
        ' parse all CustomDocumentProperties
        For Each docProp In docProps
            ' parse all slides in the active presentation (document)
            For Each processPage In Application.ActivePresentation.Slides
                ' scan all elements of page for textbox with tagged "altText/title" field with CustomDocumentProperties Name
                For Each ShapeObj In processPage.Shapes
                    If ShapeObj.TextFrame.HasText Then
                       ShapeObj.TextFrame.TextRange.Text = Replace(ShapeObj.TextFrame.TextRange.Text, "{{" & docProp.Name & "}}", docProp.Value)
                    End If
                Next ' obj
            Next ' page
        Next docProp 'Prob
    End Sub
    
    1
    • Your answer could be improved with additional supporting information. Please edit to add further details, such as citations or documentation, so that others can confirm that your answer is correct. You can find more information on how to write good answers in the help center.
      – Community Bot
      Dec 16, 2021 at 14:36

    Your Answer

    By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

    Not the answer you're looking for? Browse other questions tagged or ask your own question.