Find and Replace Text Color

[MHamid]

Hello,

Ihave the following code that will change some text color from blue to black.However, it is missing the blue text from tables, charts, etc. How can Ienhance the code below to include tables, charts, etc? Also, how can I enhancethe table to also include finding and replacing red text to black text?

Sub BlackDeletei()
Dim oSld As slide
Dim oShp As shape
Dim x As Long

For Each oSld In ActivePresentation.Slides
    For Each oShp In oSld.Shapes
        If oShp.HasTextFrame Then
            If oShp.TextFrame.HasText Then
                With oShp.TextFrame.TextRange
                    For x = .Runs.Count To 1 Step -1
                        If .Runs(x).Font.Color.RGB = RGB(0, 0, 255) Then
                            .Runs(x).Font.Color.RGB = RGB(0, 0, 0)
                        End If
                    Next x
                End With
            End If
        End If
    Next oShp
Next oSld

End Sub

Thank you

[MHamid]

Hello,

I figured it out.

Thank you

[selva_235]

Hi,

Could you please past the code what you figured it out. It is very useful for me.

Thanks

[MHamid]

My apologies. I thought I posted the functioning code.

Sub ReplaceBlueRedToBlack()
Dim oSld As Slide
Dim oShp As Shape
Dim oTbl As Table
Dim lRow As Integer
Dim lCol As Integer
Dim x As Long
For Each oSld In ActivePresentation.Slides
    For Each oShp In oSld.Shapes
        If oShp.HasTextFrame Then
            If oShp.TextFrame.HasText Then
                With oShp.TextFrame.TextRange
                    For x = .Runs.Count To 1 Step -1
                        If .Runs(x).Font.Color.RGB = RGB(0, 0, 255) Or .Runs(x).Font.Color.RGB = RGB(255, 0, 0) Then
                            .Runs(x).Font.Color.RGB = RGB(0, 0, 0)
                        End If
                    Next x
                End With
            End If
        End If
        If oShp.HasTable Then
        Set oTbl = oShp.Table
            With oTbl
                For lRow = 1 To .Rows.Count
                    For lCol = 1 To .Columns.Count
                        With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange
                            For x = .Runs.Count To 1 Step -1
                                If .Runs(x).Font.Color.RGB = RGB(0, 0, 255) Or .Runs(x).Font.Color.RGB = RGB(255, 0, 0) Then
                                    .Runs(x).Font.Color.RGB = RGB(0, 0, 0)
                                End If
                            Next x
                        End With
                    Next lCol
                Next lRow
            End With
        End If
    Next oShp
Next oSld
End Sub

[John Wilson]

Just another way to do it:

Assuming you are using a version after 2007 it is good practice to use TextFrame2 to be able to use the new formatting if required.

Sub ReplaceBlueRedToBlack()Dim oSld As Slide
Dim oshp As Shape
Dim oTbl As Table
Dim iRow As Integer
Dim iCol As Integer
For Each oSld In ActivePresentation.Slides
    For Each oshp In oSld.Shapes
    Select Case oshp.HasTable
    Case Is = True
    With oshp.Table
    For iRow = 1 To .Rows.Count
                    For iCol = 1 To .Columns.Count
                    Call fixSHAPE(.Cell(iRow, iCol).Shape)
                    Next iCol
                    Next iRow
                    End With
    Case Is = False
     Call fixSHAPE(oshp)
    End Select
    Next oshp
Next oSld
End Sub


Sub fixSHAPE(oshp As Shape)
Dim x As Long
If oshp.HasTextFrame Then
            If oshp.TextFrame2.HasText Then
                With oshp.TextFrame2.TextRange
                    For x = .Runs.Count To 1 Step -1
                        If .Runs(x).Font.Fill.ForeColor.RGB = RGB(0, 0, 255) Or .Runs(x).Font.Fill.ForeColor.RGB = RGB(255, 0, 0) Then
                            .Runs(x).Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
                        End If
                    Next x
                End With
            End If
        End If
End Sub

[selva_235]

Thank you so much for your help this code is really helpful for me