G
Greg Maxey
Hello,
Today in the New Users group a person was looking for help with marking
words throughout a document that were defined in the introduction. This
number of defined words could number in the hundreds.
The problem was as such. The object words are bold and in quotes. Other
bold words could appear in the definition e.g.,
"Lease" a legal document binding blah, blah.
Each instance of the defined words that appeared in the text the word in the
text needed to be First Cap and bold.
I figure a good starting point was the MultiWordFindAndReplace macro that
Dough Robbins, Dave Lett and others have contributed to and posted in the
groups.
I figured if I selected the entire list of defined words and definitions
that I could build an array using:
For Each oWord In Selection.Words
If oWord.Font.Bold = True And Asc(oWord.Next) = 34 And Asc(oWord.Next) =
34 Then
ListArray = ListArray & oWord & " "
End If
Next oWord
ListArray = Left(ListArray, Len(ListArray) - 1)
ListArray = Split(ListArray)
This seems to work as it results in an array of all bolded quoted words in
the selection and excluded all other bold and non-bold words.
This seems to take awhile if there are lots of words in the selection. My
first question, Have I made this harder than it needs to be? I hate to use
the phrase "better way" for fear Jonathan is reading , but I am trying to
learn and would appreaciate feedback.
For the actual marking of words in the text I used:
For i = LBound(ListArray) To UBound(ListArray)
myString = ListArray(i)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.Text = myString
On Error GoTo Done
.Replacement.Text = Format(Left(myString, 1), ">") _
& Right(myString, Len(myString) - 1)
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll
End With
Next i
Second question. Is there another way to make the first character of the
replacement string a Cap besides the string manipulation that I used?
Here is the whole code:
Public Sub WordMarker()
Dim rngstory As Word.Range
Dim ListArray
Dim oWord As Range
'Create the array by selecting the list of definitions
For Each oWord In Selection.Words
If oWord.Font.Bold = True And Asc(oWord.Next) = 34 And Asc(oWord.Next) =
34 Then
ListArray = ListArray & oWord & " "
End If
Next oWord
ListArray = Left(ListArray, Len(ListArray) - 1)
ListArray = Split(ListArray)
MakeHFValid
For Each rngstory In ActiveDocument.StoryRanges
Do
SearchAndReplaceInStory rngstory, ListArray
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range, ByRef
ListArray As Variant)
Dim i As Long
Dim myString As String
For i = LBound(ListArray) To UBound(ListArray)
myString = ListArray(i)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.Text = myString
On Error GoTo Done
.Replacement.Text = Format(Left(myString, 1), ">") _
& Right(myString, Len(myString) - 1)
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll
End With
Next i
Done:
End Sub
Public Sub MakeHFValid()
Dim lngJunk As Long
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
End Sub
Today in the New Users group a person was looking for help with marking
words throughout a document that were defined in the introduction. This
number of defined words could number in the hundreds.
The problem was as such. The object words are bold and in quotes. Other
bold words could appear in the definition e.g.,
"Lease" a legal document binding blah, blah.
Each instance of the defined words that appeared in the text the word in the
text needed to be First Cap and bold.
I figure a good starting point was the MultiWordFindAndReplace macro that
Dough Robbins, Dave Lett and others have contributed to and posted in the
groups.
I figured if I selected the entire list of defined words and definitions
that I could build an array using:
For Each oWord In Selection.Words
If oWord.Font.Bold = True And Asc(oWord.Next) = 34 And Asc(oWord.Next) =
34 Then
ListArray = ListArray & oWord & " "
End If
Next oWord
ListArray = Left(ListArray, Len(ListArray) - 1)
ListArray = Split(ListArray)
This seems to work as it results in an array of all bolded quoted words in
the selection and excluded all other bold and non-bold words.
This seems to take awhile if there are lots of words in the selection. My
first question, Have I made this harder than it needs to be? I hate to use
the phrase "better way" for fear Jonathan is reading , but I am trying to
learn and would appreaciate feedback.
For the actual marking of words in the text I used:
For i = LBound(ListArray) To UBound(ListArray)
myString = ListArray(i)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.Text = myString
On Error GoTo Done
.Replacement.Text = Format(Left(myString, 1), ">") _
& Right(myString, Len(myString) - 1)
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll
End With
Next i
Second question. Is there another way to make the first character of the
replacement string a Cap besides the string manipulation that I used?
Here is the whole code:
Public Sub WordMarker()
Dim rngstory As Word.Range
Dim ListArray
Dim oWord As Range
'Create the array by selecting the list of definitions
For Each oWord In Selection.Words
If oWord.Font.Bold = True And Asc(oWord.Next) = 34 And Asc(oWord.Next) =
34 Then
ListArray = ListArray & oWord & " "
End If
Next oWord
ListArray = Left(ListArray, Len(ListArray) - 1)
ListArray = Split(ListArray)
MakeHFValid
For Each rngstory In ActiveDocument.StoryRanges
Do
SearchAndReplaceInStory rngstory, ListArray
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range, ByRef
ListArray As Variant)
Dim i As Long
Dim myString As String
For i = LBound(ListArray) To UBound(ListArray)
myString = ListArray(i)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.Text = myString
On Error GoTo Done
.Replacement.Text = Format(Left(myString, 1), ">") _
& Right(myString, Len(myString) - 1)
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll
End With
Next i
Done:
End Sub
Public Sub MakeHFValid()
Dim lngJunk As Long
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
End Sub