Je viens d'écrire un sous-programme pour mettre les propriétés nommées dans des objets texte balisés sur toutes les diapositives.
Pour mettre une propriété de fichier sur des diapositives. Créez une zone de texte pour contenir la chaîne. Dans les propriétés / Alt Text, mettez le nom de la propriété entre crochets.
Exécutez ensuite la macro updateProperties()
.
c'est-à [title]
- dire - permettrait au titre du document d'être mis à jour sur plusieurs
Deux balises spéciales ont été écrites:
[copyright]
insérerait une chaîne de copyright, c.-à-d. © 1998-2013 P.Boothroyd, NIS Oskemen
[page]
insérerait le numéro de diapositive de l'onglet éditeur
'Copier les propriétés du document dans toutes les diapositives
«c) 2013, P.Boothroyd pour NIS Oskemen
Dim processPage As Slide
Sub updateProperties ()
Dim page comme diapositive
Dim propname As String
'analyser toutes les diapositives de la présentation active (document)
Pour chaque processPage In Application.ActivePresentation.Slides
'scanner tous les éléments de la page pour la zone de texte avec le champ "altText / title" balisé avec "["
Pour chaque obj dans processPage.Shapes
Si Left (obj.Title, 1) = "[" Then
Dim sStart, sEnd As Integer
'extraire la propriété entre crochets
sStart = 2
sEnd = InStr (2, titre obj, "]")
propname = Trim (Mid (obj.Title, sStart, sEnd - 2))
Si obj.Type = msoTextBox Then
'définissez la zone de texte sur la valeur demandée
obj.TextFrame.TextRange.Text = getProperty (propname, obj.TextFrame.TextRange.Text)
Fin si
Fin si
Suivant 'obj
Page suivante
End Sub
'récupère la propriété du document nommé (avec option par défaut)
Fonction getProperty (propname, facultatif def As String) As String
'propriété affectée de la valeur par défaut
getProperty = def
Dim trouvé comme booléen
trouvé = Faux
propname = LCase (propname)
«le droit d'auteur est une propriété générée
Si propname = "copyright" Alors
Dim auteur As String
Dim entreprise As String
Dim année De la chaîne
Dim yearTo As String
'obtenir toutes les variables appropriées
author = getProperty ("author", "")
company = getProperty ("entreprise", "")
yearFrom = getProperty ("créé", "")
yearTo = Format (Now (), "YYYY")
«insérer le symbole du droit d'auteur
getProperty = Chr (169) + ""
'attacher une année pour l'avis de droit d'auteur
Si annéeDe l'annéeJusqu'à
getProperty = getProperty + yearFrom + "-"
Fin si
getProperty = getProperty + yearTo
'ajouter l'auteur
getProperty = getProperty + "" + author
'ajouter un séparateur pour l'auteur / l'entreprise si les deux existent
Si Len (auteur)> 0 Et Len (entreprise)> 0 Alors
getProperty = getProperty & ","
Fin si
getProperty = getProperty & company
'traitée, donc retournez la valeur
trouvé = Vrai
Fin si
'insérer le numéro de diapositive dans le document
Si propname = "page" Alors
getProperty = processPage.SlideNumber
trouvé = Vrai
Fin si
'si le nom généré créé retourne la valeur
Si trouvé, alors GoTo ret
'recherche les propriétés standard MS (fichier) de la valeur nommée
Pour chaque p dans Application.ActivePresentation.BuiltInDocumentProperties
Si LCase (p.Name) = propname Then
getProperty = p.Value
trouvé = Vrai
Quitter pour
Fin si
Suivant 'p
'recherche les propriétés personnalisées de la valeur nommée
Si trouvé, alors GoTo ret
Pour chaque p dans Application.ActivePresentation.CustomDocumentProperties
Si LCase (p.Name) = propname Then
getProperty = p.Value
trouvé = Vrai
Quitter pour
Fin si
Suivant 'p
ret:
Fonction de fin