Jean-Guy Marcil said:
Bonjour,
Dans son message, < dave55 > écrivait :
In this message, < dave55 > wrote:
|| Hello,
|| I need help in writing a Word Macro that will find text in a paragraph
|| and change the paragraph to a particular font color. I have searched
|| the web and groups but can't not find any code which I can customize
|| for my use. Any help would be appreciated!
Play around with the following:
'_______________________________________
Dim SearchedWord As String
Dim CancelOrNot As Integer
Dim DocRange As Range
Dim ParColour As Range
Dim WasFound As Boolean
SearchedWord = ""
CancelOrNot = 0
WasFound = False
Do While SearchedWord = ""
SearchedWord = Trim(InputBox("What word are you looking for?", _
"Colour paragraphs"))
If SearchedWord = "" Then
CancelOrNot = MsgBox("You must type a word or cancel.", _
vbOKCancel, "No word")
'Ok = 1, Cancel = 2
If CancelOrNot = 2 Then Exit Sub
End If
Loop
Set DocRange = ActiveDocument.Range
With DocRange.Find
.ClearFormatting
.Text = SearchedWord
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
WasFound = True
Set ParColour = DocRange.Paragraphs(1).Range
ParColour.Font.Color = wdColorBlue
'In case word is found more than once in paragraph
'no need to find the word again in the same paragraph
DocRange.SetRange DocRange.Paragraphs(1).Range.End, _
ActiveDocument.Range.End
Loop
End With
If Not WasFound Then
MsgBox SearchedWord & " was not found in the document.", _
vbExclamation + vbOKOnly, "Word not found"
End If
End Sub
'_______________________________________
Hello Jean-Guy Marcil,
Thank you very much for your reply to my request for help. Your code
was very useful. I had orginally had VBA code which I got from a
number of web sites and changed it to fit my needs. I recently had a
hard drive crash and lost my macros as well the links where I had
gotten them. I tried for about a week to find the web sites but could
not so I wrote the request for help. About 6 months ago, I sent my
macros to a co-worker. He returned today from 2 weeks vacation so I
asked if he had a copy of them. He did. Below is part of the code I
use to find text, to change the paragraph color, or delete the
paragraph, and delete blank lines. I shorted it, because in the macro
I use the same basic lines finding different text. I use the macro
each work day. The text the macro searches for remains the same. I
know I was vague on what I was requesting. I do see the potential for
using the code you sent me.
I realize the code below is very simple. I hope it may help someone
else who may be trying to do the similar.
Sub My_Macro()
'
' My Macro
' Macro recorded 01/22/2004 by Person's Name
'
'Declare variable
Dim p As Paragraph
'Delete if 2 blank lines in a row
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchByte = False
.CorrectHangulEndings = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'Delete single blank line.
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchByte = False
.CorrectHangulEndings = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'Loop through all paragraphs in the active document
For Each p In ActiveDocument.Paragraphs
'Delete paragraph if the text within sentence contains PEST
If p.Range.Text Like "*PEST*" Then
p.Range.Delete
End If
Next p
'Loop through all paragraphs in the active document
For Each p In ActiveDocument.Paragraphs
'Change paragraph font to red if the text starts with Opening.
If p.Range.Text Like "Opening*" Then
p.Range.Font.Color = wdColorRed
End If
Next p
'Loop through all paragraphs in the active document
For Each p In ActiveDocument.Paragraphs
'Change paragraph font to red if the text within sentence contains
AUD.
If p.Range.Text Like "*AUD*" Then
p.Range.Font.Color = wdColorBlack
End If
Next p
End Sub
Thank you for your time, VBA code and your help!
David Joyner
