Powerpoint: Wie füge ich eine Dokumenteigenschaft (auch bekannt als "Feld") in die Folie ein?

Hat gerade eine Unterroutine geschrieben, um benannte Eigenschaften in markierte Textobjekte auf allen Folien einzufügen.

Um eine Dateieigenschaft auf Folie(n) zu setzen. Erstellen Sie ein Textfeld, um die Zeichenfolge zu halten. Setzen Sie im Text Eigenschaften/Alt den Eigenschaftsnamen in eckige Klammern.

Dann führe das Makro updateProperties() aus.

Dh [title] - ermöglicht die Aktualisierung des Dokumenttitels auf mehreren

Zwei spezielle Tags wurden geschrieben:

' 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

Eine Problemumgehung besteht darin, benutzerdefinierte Eigenschaften zu verwenden, zu denen Sie einfach "gehen" können (Sie müssen nicht durch Folien waten).

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

1. Wählen Sie Form oder Text aus, auf den Sie ein Lesezeichen setzen möchten.
2. Datei | Eigenschaften auswählen... und aktivieren Sie die Registerkarte Benutzerdefiniert.
3. Geben Sie einen Namen für das Lesezeichen ein.
4. Kreuzen Sie 'Link zum Inhalt' an. Der Wert, der im benachbarten Dropdown-Feld aufgeführt ist, wenn Sie "Link zum Inhalt" ankreuzen. ist ein Verweis auf Ihre Auswahl.
5. Klicken Sie Auf Hinzufügen.
6. Klicken Sie auf OK, um den Eigenschaftendialog zu schließen.

Nachdem Sie ein Lesezeichen erstellt haben, können Sie wie folgt darauf springen:
1. Wählen Sie Bearbeiten | Goto Eigenschaft...
2. Klicken Sie im Dialogfeld auf den Eigenschaftsnamen (dies ist der Name, den Sie dem Lesezeichen gegeben haben).
3. Klicken Sie auf Gehe zu.

Das Dialogfeld "Gehe zu" zeigt Ihnen eine Liste von Lesezeichen, auf die Sie doppelklicken können, und geht zu Ihren bevorzugten Textfeldern, bereit zum Bearbeiten / Einfügen in.

Der einfachste Weg, dies in Powerpoint zu tun (zumindest für Werte, die auf jeder Folie angezeigt werden), besteht darin, den Folienmaster zu bearbeiten. Geben Sie dort den Namen des Autors ein.

(Ein möglicher Grund, warum Word Sie und keine der anderen dies tun lässt, ist, dass die verschiedenen Teams bei Microsoft selten miteinander sprechen...)

Update für Handle Code mit ppt 2019: Ich habe die for-next-Routine ein wenig geändert, die Ursache ist, dass es für einen Front-End-Benutzer einfacher ist, den "Alternativetext" mit der rechten Maustaste zu ändern:

    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

Ich habe das Unterprogramm selbst ein wenig aktualisiert, damit es meinen Anwendungsfall behandelt: Ich musste mehrere benutzerdefinierte Eigenschaften in dasselbe Textfeld einfügen, und 1 Textfeld pro Eigenschaft konnte bei mir nicht funktionieren. Hier ist mein aktualisierter Code, wenn jemand ihn benötigt:

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

Um es zu verwenden, ändern Sie den AltText in " [CustomProperty]", dann ersetzt das Unterprogramm alle [property] im Textfeld durch ihren Wert.

Dies könnte wahrscheinlich besser mit Regex codiert werden...