VBA Code
Easy to find and replace one colour or formatting with another one
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
© 2022 Better Solutions Limited. All Rights Reserved. © 2022 Better Solutions Limited TopPrev