Acabei de escrever uma sub-rotina para colocar as propriedades nomeadas em objetos de texto marcados em todos os slides.
Para colocar uma propriedade de arquivo no (s) slide (s). Crie uma caixa de texto para armazenar a string. Nas propriedades / Alt Text, coloque o nome da propriedade entre colchetes.
Em seguida, execute a macro updateProperties()
.
i.e. [title]
- permitiria que o título do documento fosse atualizado em vários
Duas tags especiais foram escritas:
[copyright]
inseria uma cadeia de direitos autorais, ou seja, © 1998-2013 P.Boothroyd, NIS Oskemen
[page]
iria inserir o número do slide na aba do editor
' 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