Powerpoint VBA to remove/replace/delete certain colored font in textbox and in tables
Hi all,
i am trying to write a VBA code to basically replace all instances of BLUE font in my power point and replace it with blanks/underscores.
so even if in a textbox/tablecell there're other colored fonts, it will replace only the BLUE ones.
So far it works perfectly fine with my textboxes, but i'm having trouble with the tablecells part. it only replaces if the ENTIRE cell is blue font. i can't get it to work like the textboxes.
this is my code... pardon the formatting, i'm just really bad at coding.
////
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(j).Shape.TextFrame.T extRange.Font.Color.RGB = RGB(0, 0, 255) Then
oShp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.T extRange.Text = " "
oShp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.T extRange.Font.Subscript = msoFalse
oShp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.T extRange.Font.Superscript = msoFalse
End If
Next j
Next i
End If
Next oShp
Next oSld
End Sub
////
would really appreciate any help here.. i've been stuck on this for days.. the ppt file that i have is just really huge and has many slides, so having this code will definitely help the processing time.
|