View Single Post
 
Old 06-22-2016, 12:10 AM
JohnWilson JohnWilson is offline Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,913
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

See if this gets you started

Code:
Sub delblue()
   Dim oSld As Slide
   Dim oShp As Shape
   Dim x As Long
   Dim l As Long
   Dim i As Long
   Dim j As Long
   Dim otr As TextRange

   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
                        Set otr = .Runs(x)
                        For l = 1 To otr.Length
                           otr.Characters(l) = "_"
                           otr.Font.Color.RGB = RGB(120, 120, 120)
                        Next l
                        .Runs(x).Font.Subscript = msoFalse
                        .Runs(x).Font.Superscript = msoFalse
                     End If
                  Next x
               End With
            End If      'has text
         End If      'has textframe
         If oShp.HasTable Then
            For i = 1 To oShp.Table.Rows.Count
               For j = 1 To oShp.Table.Columns.Count
                  If oShp.Table.Cell(i, j).Shape.TextFrame.HasText Then
                     With oShp.Table.Cell(i, j).Shape.TextFrame.TextRange
                        For x = .Runs.Count To 1 Step -1
                           If .Runs(x).Font.Color.RGB = RGB(0, 0, 255) Then
                              Set otr = .Runs(x)
                              For l = 1 To otr.Length
                                 otr.Characters(l) = "_"
                                 otr.Font.Color.RGB = RGB(120, 120, 120)
                              Next l
                              .Runs(x).Font.Subscript = msoFalse
                              .Runs(x).Font.Superscript = msoFalse
                           End If
                        Next x
                     End With
                    End If
                  Next j
               Next i
            End If
         Next oShp
      Next oSld
   End Sub
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials

Last edited by JohnWilson; 06-22-2016 at 11:45 PM.
Reply With Quote