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:love