TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

کد زیر در متن footer، مسیرجاری را به صورت کامل همراه با نام پرزنتیشن درج می کند:

Sub FilenameInFooter()

Dim FooterText As String

' And set it to the current presentation's full path/name
FooterText = ActivePresentation.FullName
' or if you prefer just the name use
' FooterText = ActivePresentation.Name

    If ActivePresentation.HasTitleMaster Then
        With ActivePresentation.TitleMaster.HeadersFooters
            With .Footer
                .Text = FooterText
                .Visible = msoTrue
            End With
        End With
    End If

    With ActivePresentation.SlideMaster.HeadersFooters
        With .Footer
            .Text = FooterText
            .Visible = msoTrue
        End With
    End With

    With ActivePresentation.Slides.Range.HeadersFooters
        With .Footer
            .Text = FooterText
            .Visible = msoTrue
        End With
    End With

End Sub

در کد زیر متن Shape به عنوان هدف نمایش اطلاعات واقع شده است، و تاریخ فایل نیز نمایش داده می شود، این کد درباره نحوه دسترسی به اطلاعات فایل راههایی را ارائه نموده است.

Sub AddTextBoxDateFilename()
' Adds a text box with date and filename to each slide
' You must first save the presentation at least once before using this

    Dim oSl As Slide
    Dim oSh As Shape

    On Error GoTo ErrorHandler

    For Each oSl In ActivePresentation.Slides
        ' do we already have a filename/date text box?  If do, use it:
        On Error Resume Next
        Set oSh = oSl.Shapes("FilenameAndDate")
        On Error GoTo ErrorHandler

        If oSh Is Nothing Then  ' no text box there already, create one

            ' change the position and formatting to suit your needs:
            Set oSh = oSl.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 510, 720, 28.875)

            With oSh

                .Name = "FilenameAndDate"

                .TextFrame.WordWrap = msoTrue
                With .TextFrame.TextRange.ParagraphFormat
                    .LineRuleWithin = msoTrue
                    .SpaceWithin = 1
                    .LineRuleBefore = msoTrue
                    .SpaceBefore = 0.5
                    .LineRuleAfter = msoTrue
                    .SpaceAfter = 0
                End With

                With .TextFrame.TextRange.Font
                    .NameAscii = "Arial"
                    .Size = 18
                    .Bold = msoFalse
                    .Italic = msoFalse
                    .Underline = msoFalse
                    .Shadow = msoFalse
                    .Emboss = msoFalse
                    .BaselineOffset = 0
                    .AutoRotateNumbers = msoFalse
                    .Color.SchemeColor = ppForeground
                End With
            End With    ' shape

        End If  ' osh is nothing

        ' now we know there's a shape by the correct name so
        Set oSh = oSl.Shapes("FilenameAndDate")
        With oSh.TextFrame.TextRange
            .Text = ActivePresentation.FullName & vbTab & Format(Now, "mmmm dd, yyyy")
        End With

        Set oSh = Nothing


    Next    ' slide


NormalExit:
    Exit Sub

ErrorHandler:
    MsgBox ("There was a problem:" _
        & vbCrLf _
        & Err.Description)
    Resume NormalExit

End Sub