TPE
Tavvafi@gmail.com |
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
Option Explicit ' Run this only on a COPY of your original presentation Sub RunMeOnACOPYOnly() Dim oSl As Slide Dim oSh As Shape Dim lFindColor As Long Dim lChangeToColor As Long ' This sets the color we'll look for lFindColor = RGB(255, 0, 0) ' Red ' This sets the color we'll change it to lChangeToColor = RGB(255, 255, 255) ' white With ActivePresentation For Each oSl In .Slides For Each oSh In oSl.Shapes If oSh.HasTextFrame Then If oSh.TextFrame.HasText Then Call FixText(oSh, lFindColor, lChangeToColor) End If End If Next Next End With End Sub Sub FixText(oSh As Shape, lFindColor As Long, lChangeToColor As Long) Dim x As Long Dim oSl As Slide Set oSl = oSh.Parent With oSh.TextFrame.TextRange For x = 1 To .Runs.Count If .Runs(x).Font.Color.RGB = lFindColor Then .Runs(x).Font.Color.RGB = lChangeToColor With oSl.Shapes.AddLine(.Runs(x).BoundLeft, _ .Runs(x).BoundTop + .Runs(x).BoundHeight, _ .Runs(x).BoundLeft + .Runs(x).BoundWidth, _ .Runs(x).BoundTop + .Runs(x).BoundHeight) .Line.Visible = True .Line.Weight = 2 ' points .Line.ForeColor.RGB = RGB(0, 0, 0) End With End If Next End With End Sub