TPE

Tavvafi@gmail.com

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

Function BodyTextPlaceholder(oSl As Slide) As Shape
    Dim oSh As Shape
    For Each oSh In oSl.Shapes
        If oSh.Type = msoPlaceholder Then
            ' change ppPlaceholderBody to another placeholder type if you 
            ' want to get a reference to a different placeholder
            If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
                ' we found it
                Set BodyTextPlaceholder = oSh
                Exit Function
            End If
        End If
    Next    ' shape
End Function

این Function با یک ماکرو قابل تست است:

Sub TestBodyTextPlaceholder()
    Dim oSl As Slide
    Dim oSh As Shape
    Set oSl = ActivePresentation.Slides(2)
    Set oSh = BodyTextPlaceholder(oSl)
    ' If there's no placeholder, the function returns nothing, so test:
    If Not oSh Is Nothing Then
        MsgBox oSh.TextFrame.TextRange.Text
    End If
End Sub

یک function دیگه:

Function GetPlaceholder( _
    oSl As Object, _
    sPHType As String, _
    Optional lBodyPlaceholderNumber As Long = 1) _
    As Shape

    ' NOTE: oSl is DIMmed as object rather than as slide
    '       so we can pass this function
    '       a slide OR slide master, notes page, etc
    '
    ' By default, if you ask for a body placeholder, it returns the first one
    ' If you want the second body placeholder, pass a 2 as third parameter

    Dim lPlaceholderType As Long
    Dim oSh As Shape
    Dim lBodyPlaceholderCount As Long

    lBodyPlaceholderCount = 0  ' to start

    ' You could instead create an ENUM defining all of these values
    ' which would make the function easier to use (help from intellisense)
    ' but this way it's self-contained
    Select Case UCase(sPHType)
        Case Is = "TITLE"
            lPlaceholderType = 1
        Case Is = "BODY"
            lPlaceholderType = 2
        Case Is = "CENTERTITLE"
            lPlaceholderType = 3
        Case Is = "SUBTITLE"
            lPlaceholderType = 4
        Case Is = "VERTICALTITLE"
            lPlaceholderType = 5
        Case Is = "VERTICALBODY"
            lPlaceholderType = 6
        Case Is = "OBJECT"
            lPlaceholderType = 7
        Case Is = "CHART"
            lPlaceholderType = 8
        Case Is = "BITMAP"
            lPlaceholderType = 9
        Case Is = "MEDIACLIP"
            lPlaceholderType = 10
        Case Is = "ORGCHART"
            lPlaceholderType = 11
        Case Is = "TABLE"
            lPlaceholderType = 12
        Case Is = "SLIDENUMBER"
            lPlaceholderType = 13
        Case Is = "HEADER"
            lPlaceholderType = 14
        Case Is = "FOOTER"
            lPlaceholderType = 15
        Case Is = "DATE"
            lPlaceholderType = 16
        Case Is = "VERTICALOBJECT"
            lPlaceholderType = 17
        Case Is = "PICTURE"
            lPlaceholderType = 18
    End Select

    ' Check each shape on the "slide" to see if it matches the
    ' placeholder type called for

    For Each oSh In oSl.Shapes
        ' is it a placeholder in the first place?
        If oSh.Type = msoPlaceholder Then
            If oSh.PlaceholderFormat.Type = lPlaceholderType Then

                ' Body placeholder? If so, first or second?
                If lPlaceholderType = ppPlaceholderBody Then
                    lBodyPlaceholderCount = lBodyPlaceholderCount + 1
                    ' if we're looking for the first one:
                    If lBodyPlaceholderNumber = 1 Then
                        ' and this IS the first one:
                        If lBodyPlaceholderCount = 1 Then
                            Set GetPlaceholder = oSh
                            Exit Function
                        End If
                    Else    ' we're looking for the second body placeholder
                        ' and this IS the second one:
                        If lBodyPlaceholderCount = 2 Then
                            Set GetPlaceholder = oSh
                            Exit Function
                        End If
                    End If

                Else    ' we're not worried about body placeholder numbers
                    Set GetPlaceholder = oSh
                End If

            End If
        End If
    Next    ' shape

End Function

Sub TestGetPlaceholder()
    Dim oSh As Shape
    Dim oSl As Slide
    Set oSl = ActivePresentation.Slides(1)

    ' Here's how you call the function:
    Set oSh = GetPlaceholder(oSl, "body", 1)

    ' Test to make sure it returned a shape:
    If Not oSh Is Nothing Then
        MsgBox oSh.Name
    Else
        MsgBox "No such placeholder on this slide"
    End If    
End Sub