Home > Software design >  MS Word VBA Can't select specific words to change background color
MS Word VBA Can't select specific words to change background color

Time:05-30

I am trying to write vba code to change the background color of specific words with no luck. I have code that will change the background color but not when I ask for specific words. I have SQL code and I am trying to have all fields from the query be highlighted in bright green, So my plan is to just enter field names and have those terms highlighted in bright green. Currently if I take the if statement out, the first line will be highlighted in bright green. I have over 3200 words to go through.

Dim oSentence As Variant
Dim strSentence As String

strSentence = "Package_Policy_TA"

For Each oSentence In ActiveDocument.Sentences
    Debug.Print oSentence

        If oSentence = strSentence Then

            Stop
            oSentence.Font.Shading.BackgroundPatternColorIndex = wdBrightGreen


        End If

    Next oSentence

CodePudding user response:

Please, try the next way:

Sub colorDocumentSpecificWords()
   Dim d As Document, w As Long, wd As Long, arrW
   
   Set d = ActiveDocument
   arrW = Split("word1 word2 word3 word4", " ") 'place here the words (from what you name 'query', space separated
   For w = 1 To d.Words.count
        For wd = 0 To UBound(arrW)
            If d.Words(w) = arrW(wd) Then
                d.Words(w).Font.Shading.BackgroundPatternColorIndex = wdBrightGreen
                Exit For
            End If
        Next wd
   Next w
End Sub

CodePudding user response:

For example:

Sub HiliteWords()
Application.ScreenUpdating = False
Dim ArrFnd As Variant, i As Long
'Array of Find expressions
ArrFnd = Array("policy_Id", "another term", "yet another term")
With ActiveDocument
  For i = 0 To UBound(ArrFnd)
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Forward = True
        .Wrap = wdFindStop
        .MatchCase = True
        .MatchWholeWord = True
        .Text = ArrFnd(i)
        .Replacement.Text = ""
      End With
      Do While .Find.Execute
        .Font.Shading.BackgroundPatternColorIndex = wdBrightGreen
        .Collapse wdCollapseEnd
      Loop
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

CodePudding user response:

When I use your code none of the fields are updating to the color. To go back to the beginning I have copied code from a dtsx package, my goal of the code is to find all the fields from the query and change the color to bright green. To find all the table names and change the background color of all the table names to purple. When I use your code it loops through words but any separators the code thinks it is a new word. For example the first word is policy_id and when the code loops it finds that policy, _ and id are three separate words so it never finds a match. I need the code to look at everything that is after the SELECT statement for the fields and everything after the FROM statement for the tables.

A sample of the code I am comparing is : Data Flow task: DF STEP 1

Container Name: BK from Premium-waiver
OLE DB Connection Manager: CLTCAS

Tables: dbo.policy_payer_option, dbo.policy, dbo.product_option

SQL Command
SELECT DISTINCT 
   p.policy_id
FROM dbo.policy_payer_option polpo (NOLOCK)
    INNER JOIN dbo.policy p (NOLOCK)

When I use your idea of using the split that part works. But I still cant get the comparison function to work.

Public Sub ChangeBackground()


Dim d As Document
Dim w As Long
Dim wd As Long
Dim arrW As Variant
Dim strWord1 As String
Dim strWord2 As String
Dim strWord3 As String
Dim strWord4 As String
Dim strFullString As String
Dim strArray As String
Dim oSentence As Variant
Dim x As Long

strWord1 = "p.policy_id"
strWord2 = "policy_payer_option"
strWord3 = "rpt_coverage"
strWord4 = "coverage_id"

strFullString = strWord1 & Chr(44) & strWord2 & Chr(44) & strWord3 & Chr(44) & 
strWord4

Set d = ActiveDocument
arrW = Split(strFullString, ",")  'place here the words (from what you name 
'query', space separated
'   For w = 1 To d.Words.Count

    For Each oSentence In ActiveDocument.Sentences
    'For wd = 0 To UBound(arrW)
     For x = 0 To 3

     Debug.Print "Words ", Trim(oSentence)
     Debug.Print "Array ", Trim(arrW(x))

        If Trim(oSentence) = Trim(arrW(x)) Then
        
'If d.Words(w) = arrW(wd) Then
'd.Words(w).Font.Shading.BackgroundPatternColorIndex = wdBrightGreen
        
        Trim(oSentence).Font.Shading.BackgroundPatternColorIndex = wdBrightGreen

            Exit For
        End If
'Next wd
    Next x
    Next oSentence
    Debug.Print "Complete"
  End Sub

When I run this code when I get to the line p.policy_id the debug.print statements print, Array p.policy_id Words p.policy_id which looks like a match , but the line If Trim(oSentence) = Trim(arrW(x)) Then still skips

  • Related