PowerPoint：ドキュメントプロパティ（別名「フィールド」）をスライドに挿入する方法

PowerPoint 2007のスライドにドキュメントプロパティ（作成者の名前など）を挿入するにはどうすればよいですか？これはMicrosoft Wordで実行できることは知っていますが、PowerPointで実行する方法が見つかりません。

（ドキュメントプロパティを使用すると、たとえば、異なるマスターページを使用している場合でも、すべてのスライドのフッターのコンテンツを簡単に変更できます。別のソリューションがあれば、それでも問題ありません。）

Wordはこれを行うことができますが、PowerPointはできません。知る限り、PPTでドキュメントプロパティを使用できますが、スライドに挿入することはできません。PowerPointで使用できる更新フィールドは、日付とスライド番号のみです。とにかく、VBAでこれを達成するための回避策があるかもしれません。Stackoverflowでこれを聞いてチャンスをつかむことができます。

すべてのスライドのタグ付きテキストオブジェクトに名前付きプロパティを配置するサブルーチンを作成しました。

ファイルプロパティをスライドに配置します。文字列を保持するテキストボックスを作成します。プロパティ/ Altテキストで、プロパティ名を角括弧に入れます。

次にマクロを実行しupdateProperties()ます。

すなわち[title]-複数のドキュメントのタイトルを更新することができます

2つの特別なタグが記述されています。

'ドキュメントのプロパティをすべてのスライドにコピーします
'（c）2013、NISオスケメンのP.ブースロイド
スライドとして薄暗いprocessPage

サブupdateProperties（）
    スライドとして薄暗いページ
    文字列として薄暗いpropname
    'アクティブなプレゼンテーション（ドキュメント）内のすべてのスライドを解析します
    Application.ActivePresentation.Slidesの各processPageについて
        'タグ付きの「altText / title」フィールドに「[」を含むテキストボックスのページのすべての要素をスキャンします
        processPage.Shapesの各オブジェクト
            If Left（obj.Title、1）= "[" Then
                Dim sStart、sEnd As Integer
                '角括弧の間からプロパティを抽出します
                sStart = 2
                sEnd = InStr（2、obj.Title、 "]"）
                propname = Trim（Mid（obj.Title、sStart、sEnd-2））
                If obj.Type = msoTextBox Then
                    'テキストボックスを要求された値に設定します
                    obj.TextFrame.TextRange.Text = getProperty（propname、obj.TextFrame.TextRange.Text）
                終了する
            終了する
        次 'obj
    次のページ
サブ終了

'名前付きドキュメントプロパティを取得します（オプションのデフォルトを使用）
関数getProperty（propname、オプションとしてdef As String）As String
    'プロパティにデフォルト値が割り当てられました
    getProperty = def
    ブール値として見つかった薄暗い
    見つかった= False
    propname = LCase（propname）

    '著作権は生成されたプロパティです
    propname = "copyright"の場合Then
        文字列としてのDim author
        文字列としての薄暗い会社
        Dim yearFrom As String
        Dim yearTo As String

        'すべての適切な変数を取得します
        author = getProperty（ "author"、 ""）
        company = getProperty（ "company"、 ""）
        yearFrom = getProperty（ "created"、 ""）
        yearTo = Format（Now（）、 "YYYY"）

        '著作権記号を挿入
        getProperty = Chr（169）+ ""

        '著作権表示の年間スパンを添付
        if yearFrom yearTo Then
            getProperty = getProperty + yearFrom + "-"
        終了する
        getProperty = getProperty + yearTo

        '著者を追加
        getProperty = getProperty + "" + author

        '作成者/会社の両方が存在する場合、区切り文字を追加します
        Len（author）> 0 And Len（company）> 0 If
            getProperty = getProperty＆ "、"
        終了する
        getProperty = getProperty＆company

        '処理されたため、値を返します
        見つかりました= True
    終了する

    'スライド番号をドキュメントに挿入します
    propname = "page"の場合Then
        getProperty = processPage.SlideNumber
        見つかりました= True
    終了する

    '生成された名前が作成された場合、値を返します
    見つかったら、GoTo ret

    '名前付き値の標準MS（ファイル）プロパティをスキャンします
    Application.ActivePresentation.BuiltInDocumentPropertiesの各p
        LCase（p.Name）= propname Then
            getProperty = p.Value
            見つかりました= True
            出口
        終了する
    次 'p

    '名前付き値のカスタマイズされたプロパティをスキャンします
    見つかったら、GoTo ret
    Application.ActivePresentation.CustomDocumentPropertiesの各p
        LCase（p.Name）= propname Then
            getProperty = p.Value
            見つかりました= True
            出口
        終了する
    次 'p
ret：
終了機能

回避策は、簡単に「移動」できるカスタムプロパティを使用することです（スライドを歩く必要はありません）。

http://msdn.itags.org/powerpoint/4426/から ：

1. ブックマークを設定する図形またはテキストを選択します。
2. ファイルを選択| プロパティ...をクリックし、カスタムタブをアクティブにします。
3. ブックマークの名前を入力します。
4. 「コンテンツへのリンク」にチェックマークを付けます。[コンテンツへのリンク]にチェックマークを付けたときに、隣接するドロップダウンボックスにリストされる値は、選択への参照です。
5. 追加をクリックします。
6. [OK]をクリックして[プロパティ]ダイアログを閉じます。

ブックマークを作成したら、次のようにブックマークにジャンプでき
ます。プロパティに移動...
2.ダイアログからプロパティ名をクリックします（これはブックマークに付けた名前です）。
3. [移動]をクリックします。

[移動]ダイアログには、ダブルクリックできるブックマークのリストが表示され、お気に入りのテキストボックスに移動して、編集/貼り付けの準備ができます。

Powerpointでこれを行う最も簡単な方法（少なくともすべてのスライドに表示される値の場合）は、スライドマスターを編集することです。そこに著者名を入れてください。

（Wordで可能になった理由の1つは、Microsoftのさまざまなチームが互いに会話することはめったにないということです...）

ppt 2019によるハンドルコードの更新：for-nextルーチンを少し変更しました。これは、フロントエンドユーザーがマウスの右ボタンで「代替テキスト」を簡単に変更できるためです。

    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