Replace specifc text color with other color in multiple slides of same Powerpoint Presentation

Question

I am having a presentation in which i have more than 200 slides. Evevry slide contains multiple lines. In each line of each slide, there is some part of text that is highlighted to blue color. I wan to change that blue color to some other color.

I want this change to be reflected in all slides, mean that specific color should be replaced by my new color and it should not affect other text color because it is in other color because i want to emphasize on that point.

In short, replacing specific color in specific part of text with other color in all slides.

Solution

Here's an answer from the PowerPoint FAQ at http://www.pptfaq.com

Problem

You have lots of text in lots of slides. Some of it has been set to a color that you now need to change. This will help.

Option Explicit

Sub ChangeTextColors()

    Dim oSl As Slide
    Dim oSh As Shape
    Dim lCol As Long
    Dim lRow As Long
    Dim x As Long

    Dim lOldColor As Long
    Dim lNewColor As Long

    ' EDIT THESE TO THE COLORS YOU WANT TO CHANGE FROM and TO
    lOldColor = RGB(100, 200, 100)
    lNewColor = RGB(200, 100, 200)

    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes

            If oSh.HasTextFrame Then
                If oSh.TextFrame.HasText Then
                    Call ChangeTextRange(oSh.TextFrame, lOldColor, lNewColor)
                End If
            End If

            If oSh.HasTable Then
                With oSh.Table
                    For lCol = 1 To .Columns.Count
                        For lRow = 1 To .Rows.Count
                            Call ChangeTextRange(.Cell(lRow, lCol).Shape.TextFrame, lOldColor, lNewColor)
                        Next
                    Next
                End With
            End If

' this part is commented out because PPT 's buggy and ... sorry ... haven't quite figured it out yet:
'            If oSh.HasSmartArt Then
'                With oSh.SmartArt
'                    For x = 1 To .Nodes.Count
'                        Call ChangeTextRange(.Nodes(x).TextFrame2, lOldColor, lNewColor)
'                    Next
'                End With
'            End If

            If oSh.HasChart Then
                ' You're on your own, my friend
            End If

        Next
    Next

End Sub

Sub ChangeTextRange(oTextFrame As Object, lOldColor As Long, lNewColor As Long)

    Dim x As Long

    With oTextFrame.TextRange
        For x = 1 To .Runs.Count
            If .Runs(x).Font.Color.RGB = lOldColor Then
                .Runs(x).Font.Color.RGB = lNewColor
            End If
        Next
    End With

End Sub