it-swarm-ja.com

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

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

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

34
Rabarberski

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

20

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

ファイルプロパティをスライドに配置するには。文字列を保持するテキストボックスを作成します。 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

    自分でユースケースを処理できるようにサブルーチンを少し更新しました。同じテキストボックスにいくつかのカスタムプロパティを挿入する必要があり、プロパティごとに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