How can I change the font color to all the text boxes with the same object name in an entire workbook to red?

Question

I am looking to change the color to all the text boxes with the name "Content Placeholder1" to red.

I use the following function to copy and paste an object from ppt to excel. I also use to change the color of the font to red, but it is not working on some the textboxes. Most sheets have 1 texbox. Except one sheet has about 4. In that sheet only 1 texbox changes color. How can I make them all set to the color font color red?

 Function paste_from_slide(slideIndex As Integer, _
    targetWsName As String, destinationRng As String, Optional shapeName As String = "Content Placeholder 1")

    Dim pptShape As PowerPoint.Shape
    Dim pptSlide As PowerPoint.Slide
    Dim exlShape As Excel.Shape
    Dim s As Shape

    Dim Ws As Excel.Worksheet
    Dim Rng As Excel.Range

    Set Ws = Excel.ThisWorkbook.Worksheets(targetWsName)
    Set Rng = Ws.Range(destinationRng)

    Set pptSlide = Ppt.ActivePresentation.Slides(slideIndex)
    Set pptShape = pptSlide.Shapes(shapeName)
        pptShape.Copy
         ActiveSheet.Paste Destination:=Ws.Range(destinationRng)

    Set s = Ws.Shapes("Content Placeholder 1")

s.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)


End Function

Answer 1

• Shape names are not a reliable indicator of the actual shape type.
• Naming placeholders with the same name can cause content to rotate randomly among them when you switch layouts, so the revised code doesn't rely on the name.
• Trying to fill the text if there is no text will raise an error.
• There's no reason to make this a function, since it doesn't return anything.

Please give this code a try:

Sub paste_from_slide(slideIndex As Integer, _
    targetWsName As String, destinationRng As String, Optional shapeName As String)

    Dim pptShape As PowerPoint.Shape, oShape As Shape
    Dim pptSlide As PowerPoint.Slide
    Dim exlShape As Excel.Shape
    Dim s As Shape
    Dim Ws As Excel.Worksheet
    Dim Rng As Excel.Range

    Set Ws = Excel.ThisWorkbook.Worksheets(targetWsName)
    Set Rng = Ws.Range(destinationRng)
    Set pptSlide = Ppt.ActivePresentation.Slides(slideIndex)

    For Each pptShape In pptSlide
        If pptShape.Type = msoPlaceholder Then  'Check shape is a placeholder, as the name is an unreliable indicator.
            If pptShape.PlaceholderFormat.Type = ppPlaceholderObject Then   'Check that the placeholder is the right type.
                'If you still want to check the name, add an If/Then here to do that.
                Set oShape = pptShape
                If oShape.TextFrame2.HasText Then   'Trying to fill the text of a placeholder that doesn't have any will raise an error
                    oShape.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
                End If
                oShape.Copy
                ActiveSheet.Paste Destination:=Ws.Range(destinationRng)
            End If
        End If
    Next pptShape
End Sub