Find and replace one color with another on fills, text and borders

Description

While it is easy to replace one color with another if color schemes are used, the same cannot be said if the colors have been manually changed to another. The routine below, lets you do that. You can locate a particular color and replace it with the desired one for text, fills or borders of a shape.

' ---------------------------------------------------------------------
' Copyright ©1999-2007 Shyam Pillai. All Rights Reserved.
' ---------------------------------------------------------------------

' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or 
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' ---------------------------------------------------------------------

Option Explicit

Sub RecolourShapes()
Dim oSld As Slide
Dim oShp As Shape
Dim I As Integer
For Each oSld In ActivePresentation.Slides
    For Each oShp In oSld.Shapes
        If oShp.Type = msoGroup Then
            For I = 1 To oShp.GroupItems.Count
                Call FindAndReColourText(oShp.GroupItems(I), _
                                         RGB(100, 100, 100), RGB(255, 0, 255))
                Call FindAndReColourFill(oShp.GroupItems(I), _
                                         RGB(255, 255, 255), RGB(255, 0, 255))
                Call FindAndReColourBorder(oShp.GroupItems(I), _
                                           RGB(100, 100, 100), RGB(255, 0, 255))
            Next I
        Else
            Call FindAndReColourText(oShp, _
                                     RGB(100, 100, 100), RGB(255, 0, 255))
            Call FindAndReColourFill(oShp, _
                                     RGB(255, 255, 255), RGB(255, 0, 255))
            Call FindAndReColourBorder(oShp, _
                                       RGB(100, 100, 100), RGB(255, 0, 255))
        End If
    Next oShp
Next oSld
End Sub

Function FindAndReColourText(oShp As Shape, _
                             oRGB As Long, oNewRGB As Long)
Dim I As Integer
Dim oTxtRng As TextRange
On Error Resume Next
If oShp.HasTextFrame Then
    If oShp.TextFrame.HasText Then
        Set oTxtRng = oShp.TextFrame.TextRange
        For I = 1 To oTxtRng.Runs.Count
            With oTxtRng.Runs(I).Font.Color
                If .Type = msoColorTypeRGB Then
                    If .RGB = oRGB Then
                        .RGB = oNewRGB
                    End If
                End If
            End With
        Next I
    End If
End If
End Function

Function FindAndReColourFill(oShp As Shape, _
                             oRGB As Long, oNewRGB As Long)
On Error Resume Next
If oShp.Fill.Visible Then
    If oShp.Fill.ForeColor.RGB = oRGB Then
        oShp.Fill.ForeColor.RGB = oNewRGB
    End If
End If
End Function

Function FindAndReColourBorder(oShp As Shape, _
                               oRGB As Long, oNewRGB As Long)
On Error Resume Next
If oShp.Line.Visible Then
    If oShp.Line.ForeColor.RGB = oRGB Then
        oShp.Line.ForeColor.RGB = oNewRGB
    End If
End If
End Function