web-dev-qa-db-ja.com

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

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

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

microsoft-powerpointpropertiesfield-codes
34
Rabarberski

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

20
Mehper C. Palavuzlar

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

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

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

つまり、[title]-複数のドキュメントタイトルを更新できます

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

  • [copyright]は著作権文字列を挿入します。つまり、©1998-2013 P.Boothroyd、NIS Oskemen
  • [page]は、エディタのタブからスライド番号を挿入します
    •  'ドキュメントのプロパティをすべてのスライドにコピーします
'（c）2013、P.Boothroyd for NIS Oskemen 
 Dim processPage As Slide 
 
 Sub updateProperties （）
 Dim page As Slide 
 Dim propname As String 
 'アクティブなプレゼンテーション（ドキュメント）のすべてのスライドを解析します
 For Each processPage In Application.ActivePresentation.Slides 
 'タグ付きの「altText/title」フィールドが付いたテキストボックスのページのすべての要素をスキャンし、「
 For Each obj In 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）
 End If 
 End If 
 Next 'obj 
 Next'ページ
 End Sub 
 
 '名前付きドキュメントプロパティを取得します（オプションのデフォルトを使用）
 Function getProperty（propname、Optional As Def As String）As String 
 'プロパティにデフォルト値が割り当てられています
 getProperty = def 
 Dim found As Boolean 
 found = False 
 propname = LCase（propname）
 
 '著作権は生成されたプロパティです。
 If propname = "copyright" Then 
 Dim author As String 
 Dim company As String 
 Dim yearFrom As String 
 Dim yearTo As String 
 
 '適切な変数をすべて取得
 author = getProperty（ "author"、 ""）
 company = getProperty（ "company"、 ""）
 yearFrom = getProperty（ "created"、 ""）
 yearT o = Format（Now（）、 "YYYY"）
 
 '著作権記号を挿入
 getProperty = Chr（169）+ "" 
 
 '著作権表示の年スパンを添付します
 If yearFrom yearTo Then 
 getProperty = getProperty + yearFrom + "-" 
 End If 
 getProperty = getProperty + yearTo 
 
 '著者を追加
 getProperty = getProperty + "" + author 
 
'著者/会社のセパレータが両方存在する場合は追加します
 Len（author）> 0 And Len（company）> 0 Then 
 getProperty = getProperty＆ "、" 
 End If 
 getProperty = getProperty＆company 
 
 '処理されたので、値を返します
 found = True 
 End If 
 
'スライド番号をドキュメントに挿入します
 If propname = "ページ" Then 
 getProperty = processPage.SlideNumber 
 found = True 
 End If 
 
 '生成された名前が作成された場合、値を返します
見つかった場合、GoTo ret 
 
'の標準MS（ファイル）プロパティをスキャンします名前付き値
 For Each p In Application.ActivePresentation.BuiltInDocumentProperties 
 If LCase（p.Name）= propname Then 
 getProperty = p.Value 
 found = True 
 Exit For 
 End If 
 Next 'p 
 
'名前付き値のカスタマイズされたプロパティをスキャンします
見つかった場合はGoTo ret 
 For p in Application.ActivePresentation.CustomDocumentProperties 
 If LCase（p.Name）= propname Then 
 getProperty = p.Value 
 found = True 
 For For 
 End If 
 Next 'p 
 ret：
 End Function
    6
    P.Boothroyd

    回避策は、簡単に「移動」できる（スライドをたどる必要がない）カスタムプロパティを使用することです。

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

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

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

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

    1
    thenonhacker

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

    （Wordがあなたを許可し、他の誰もあなたを許可しない可能性のある理由は、Microsoftのさまざまなチームがめったに互いに話し合わないということです...）

    1
    Tor Iver Wilhelmsen

    自分でユースケースを処理できるようにサブルーチンを少し更新しました。同じテキストボックスにいくつかのカスタムプロパティを挿入する必要があり、プロパティごとに1つのテキストボックスが機能しませんでした。誰かが必要に応じて更新したコードを次に示します。

    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

    これを使用するには、AltTextを "[CustomProperty]"に変更します。その後、サブルーチンは、テキストボックス内のすべての[プロパティ]をその値に置き換えます。

    これはおそらく正規表現を使用してよりよくコーディングできます...

    0
    Scaum

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

        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
    0
    Patric Tilge