Powerpoint VBA to remove/replace/delete certain colored font in textbox and in tables

Question

i am trying to get the tables portion to replace all instances of the blue font, leaving the black font alone. (and not only if the cell was entirely blue font)

any help?

////

Sub delblue()

Dim oSld As Slide

Dim oShp As Shape

Dim x As Long

Dim i As Long

Dim j As Long

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

.Runs(x).Text = "_____________"

.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.Rows.Item(i).Cells(

Answer 1

You just have to plug in my example:

If oShp.HasTable Then

  For i = 1 To oShp.Table.Rows.Count

     For j = 1 To oShp.Table.Columns.Count

        Dim oCllShp As Shape

        Set oCllShp = oShp.Table.Cell(i, j).Shape

        Dim R As Long

        For R = oCllShp.TextFrame2.TextRange.Runs.Count To 1 Step -1

            With oCllShp.TextFrame2.TextRange.Runs(R)

                If .Font.Fill.ForeColor.RGB = RGB(0, 0, 255) Then

                    .Text = "________"

                    .Font.Subscript = msoFalse

                    .Font.Superscript = msoFalse

                End If

            End With

        Next

    Next j

    Next i

 End If

Answer 2

There is some code in the other forum you posted to.

The code here works for me though.

Answer 3

Hi Shyam, 

thanks so much for your help. the code works, although there was a runtime error. but when i ran the code the second time, the blue font all disappeared from the tables!

thanks! if there's any advice regarding the error msg, i'd really appreciate it, but the code works fine when run twice!

regards,

L

Answer 4

hi Shyam, 

thanks for the response. i realized that my initial code got cut off half-way. this was the remaining of it. 

could you help me tweak it to include the "runs" portion?

If oShp.HasTable Then

 For i = 1 To oShp.Table.Rows.Count

    For j = 1 To oShp.Table.Columns.Count

If oShp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 255) Then

oShp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Text = " "

oShp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Font.Subscript = msoFalse

oShp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Font.Superscript = msoFalse

End If

Next j

Next i

End If

        Next oShp 

Next oSld

End Sub

Answer 5

Here is an example to process table text. You can expand on that.

Sub TableProcess()

Dim cllShp As Shape

Dim tbl As Table

Dim I As Long

Dim J As Long

Dim R As Long

Set tbl = ActiveWindow.Selection.ShapeRange(1).Table

For I = 1 To tbl.Rows.Count

    For J = 1 To tbl.Columns.Count

        Set cllShp = tbl.Cell(I, J).Shape

        For R = cllShp.TextFrame2.TextRange.Runs.Count To 1 Step -1

            With cllShp.TextFrame2.TextRange.Runs(R)

                If .Font.Fill.ForeColor = RGB(255, 0, 0) Then

                    .Text = "________"

                End If

            End With

        Next

    Next

Next

End Sub