VBA Word - Find Text Font Color

jc491 · #1 01-04-2016, 08:07 AM

Hello,

to all this Monday.

I hope everyone is doing great today

I have encountered a text font problem today.

I thought it was simple enough - so I attempted to code it, however something is not quite right.

My document has text that is different colored , it may be 1 word or a string of words.

I simply wanted to insert some placeholders before and after these words.

I thought it would be a simple feat.

However the VBA dragon is strong today - I just can't get it to work.

My attempt at coding this:

Code:

Sub FontColorPlaceholders()

'Find the RGB Font Color of Specific Text  - Insert editing Placeholders

Dim oRng As Word.Range
Set oRng = ActiveDocument.Range

intPosition = oRng.End
oRng.Start = intPosition


 With oRng.Find
  .Text = " "


If oRng.Font.Color = RGB(255, 0, 102) Then

    oRng.InsertBefore "[KEEP]" & vbCrLf
    oRng.InsertAfter "[END]" & vbCrLf


    ElseIf oRng.Font.Color = RGB(255, 0, 102) Then

        oRng.InsertBefore "[EDIT]" & vbCrLf
        oRng.InsertAfter "[END]" & vbCrLf
    
    
    ElseIf oRng.Font.Color = RGB(0, 176, 240) Then

        oRng.InsertBefore "[MOVE]" & vbCrLf
        oRng.InsertAfter "[END]" & vbCrLf


' Some more if elses ........

End If

End With
End Sub

I've tried a number of other ways to get this to work, but now I've become confused between the text, string, paragraph and range objects.

I would be so grateful for some help.

Thank you so much for your help

J

macropod · #2 01-04-2016, 04:41 PM

Try something based on:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim ArrClr, ArrPref, ArrSuff, i As Long
ArrClr = Array(RGB(255, 0, 102), RGB(0, 176, 240))
ArrPref = Array("[KEEP]" & vbCrLf, "[MOVE]" & vbCrLf)
ArrSuff = Array("[END]" & vbCrLf, "[END]" & vbCrLf)
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  For i = 0 To UBound(ArrClr)
    .Font.Color = ArrClr(i)
    .Replacement.Text = ArrPref(i) & "^&" & ArrSuff(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

I haven't incorporated your "[EDIT]"/"[END]" code as you've already used its colours for your "[KEEP]"/"[END]" code.

jc491 · #3 01-04-2016, 05:42 PM

Hello Paul,

Happy New Year!

Thank you for slaying this dragon

After going from range to range to off range - I thought I'd better ask, if I don't know what mistakes I am making - I can never improve - so feedback I receive via code and showing me other ways to do it are invaluable.

I was really annoyed at my self - as I know how to work with paragraph and generic ranges. Baby steps.....

Why it would not work with text was beyond me, I know now - I can use the array.

The if else I use so often is due to getting really tangled with arrays and loops - I end up looped

Of course your array is so much more elegant and efficient.

Thank you so much - really really chuffed to bits.

I can adapt this now to some other tasks.As always, smashingly flawless code.

thank you so much for generously helping me

Have a great Week!

J

Solved as Usual

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Remove white text background (keeping the font color and page color intact	cc3125	Word	1	10-26-2015 06:44 PM
Is there an option to choose font color when replacing text in Excel 2003?	chr2014	Excel	8	11-14-2014 09:13 PM
how to search and replace BOLD text >> font color change?	dylansmith	Word	4	03-12-2013 09:51 PM
text color and font buttons	gblackstien	Word	0	09-25-2012 05:19 AM
Hwo to insert text of a different font by default	cgott42	Word	2	08-19-2012 09:00 AM