Просто написал подпрограмму для помещения именованных свойств в текстовые объекты с тегами на всех слайдах.
Поместить свойство файла на слайды. Создайте текстовое поле для хранения строки. В свойствах /Alt Text поместите имя свойства в квадратные скобки.
Затем выполните макрос updateProperties()
.
то есть [title]
- позволит заголовок документа обновляться на нескольких
Два специальных тега были написаны:
[copyright]
вставит строку авторского права, например, © 1998-2013 P.Boothroyd, NIS Oskemen
[page]
вставит номер слайда из вкладки редактора
' 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