Remembering initial caps set in a document

G

Guest

We produce a lot of very detailed and complex legal documents which often
have hundreds of "defined" words in them.

These words are defined at the front of a document in initial cap and bold,
like this "Agreement", "Superior Landlord" etc

Whenever these definitions are referred to throughout the document, all
instances of these defined words should be with an initial capital.

Obviously the problem comes if a document has hundreds of defined words, and
is very long, it is difficult to remember which words have been defined, and
which haven't, and so inconsistencies crop up in the document. Users are
supposed to do a "find and replace" on all defined words, but this can take
some time if there are a huge number of definitions.

What I would like to know is, is there any way that the definitions could be
cross-referenced on a document by document basis, so that whenever an
instance of the definition appears, it automatically changes it to initial
cap?

You could use "Autocorrect" but that is template based, and would not work
on a document by document basis (i'm presuming).

I have a feeling this would require the use of an addin and/or Visual Basic
but at the moment i'm stumped.

Any ideas?
 
G

Greg

markymids,

I have adapted a multiword find and replace macro that might suit your
needs. You will need to define a list of words in a single column
table with a the heading "Find" then run the macro:

Option Explicit
Public Sub MultiWordFindReplace()

Dim rngstory As Word.Range
Dim ListArray
Dim WordList As Document

' Change the path and filename in the following to suit where you have
your list of words
Set WordList = Documents.Open(FileName:="C:\Find and Replace
List1.doc")
ListArray = WordList.Tables(1).Range.Text
ListArray = Split(ListArray, Chr(13) & Chr(7))
WordList.Close

'Fix the skipped blank Header/Footer problem
MakeHFValid
'Iterate through all story types in the current document
For Each rngstory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SearchAndReplaceInStory rngstory, ListArray
' Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next

End Sub
Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range, ByRef
ListArray As Variant)
'This routine supplied by Peter Hewett and modified by Greg Maxey
ResetFRParameters
Dim i As Long
Dim j As Long
Dim myString As String
'This routine supplied by Peter Hewett
'For i = LBound(ListArray) To UBound(ListArray) - 1 Step 2
For i = 2 To UBound(ListArray) - 1 Step 2
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ListArray(i)
On Error GoTo Done
.Replacement.Text = Format(Left(ListArray(i), 1), ">") &
Right(ListArray(i), Len(ListArray(i)) - 1)
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll
End With
Next i
Done:
End Sub
Public Sub MakeHFValid()
'And this too
Dim lngJunk As Long
' It does not matter whether we access the Headers or Footers property.
' The critical part is accessing the stories range object
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
End Sub
Sub ResetFRParameters()

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

End Sub

Note. I am not too sure of the error handler. If anyone else can
improve on that or any other part of this code I would be interested.
 
S

Suzanne S. Barnhill

To correct one misconception: AutoCorrect is *not* template based.
AutoCorrect entries are stored in .acl files, one per language and are
global, applying to all Office documents (not just Word).

--
Suzanne S. Barnhill
Microsoft MVP (Word)
Words into Type
Fairhope, Alabama USA

Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.
 
G

Guest

Thank you for the quick response Greg :)

Unfortunately the array would need to be from within the document - and it
would not be possible to link to an external document. The definitions are
specific on a per document basis (ie different words are defined in different
documents).

Could the multiword find and replace code not be adapted so as to look for
defined words within say a bookmarked section of text within the document
itself?
 
G

Greg

markymids,

What if you select the section of defined words and run this revised
code:

Public Sub MultiWordFindReplace()

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 Then
ListArray = ListArray & oWord
End If
Next oWord


ListArray = Split(ListArray)

'Fix the skipped blank Header/Footer problem
MakeHFValid
'Iterate through all story types in the current document
For Each rngstory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SearchAndReplaceInStory rngstory, ListArray
' Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next

End Sub
Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range, ByRef
ListArray As Variant)
ResetFRParameters
Dim i As Long
For i = LBound(ListArray) To UBound(ListArray)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ListArray(i)
On Error GoTo Done
.Replacement.Text = Format(Left(ListArray(i), 1), ">") &
Right(ListArray(i), Len(ListArray(i)) - 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
Sub ResetFRParameters()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With


End Sub
 
G

Guest

Greg, you are a star! That is almost working perfectly.

The only problems I can foresee with this are:

1. It only Finds and replaces emboldened words, in our documents
definitions are in bold and enclosed in "quotes". Therefore when creating
the array it needs to only include those words which are in bold AND enclosed
in quotes.

However when it runs the macro it needs to remove these quotes (as
definitions in the body of the document will not be in quotes).

2. It must only find and replace exact matches only. For example if I ran
the code on a definition of "Lease" it should not find and replace the word:
leasehold for example, it should only find and replace lease (replacing it
with Lease).

Thanks again for your stellar suggestion, I am finally seeing light at the
end of the tunnel here!

Would it be a big job for the code to tell you (via a message box) how how
many replacements it had made in the document?

Regards
 
G

Greg

OK. This one will build the array consisting of "BOLD" words and
exludes BOLD words in your selection. Only select the list of
definitions (why are there other bold words in the list?).

Would it be a big job for the code to tell you (via a message box) how
how
many replacements it had made in the document?

For me yes. I believe it could be done. Instead of using:
..Execute Replace:=wdReplaceAll

You would need to something Like Do While .Execute

replace.text
sequence a
counter
collapse
the range
Loop
MsgBox "Report count"

It would slow things down and I can't get my head around it at present.
Check out my website:

http://gregmaxey.mvps.org/word_tips.htm
and the helpful links contain therein :)

Option Explicit
Public Sub MultiWordFindReplace()

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 Then
ListArray = ListArray & oWord & " "
End If
Next oWord

ListArray = Split(ListArray)

'Fix the skipped blank Header/Footer problem
MakeHFValid
'Iterate through all story types in the current document
For Each rngstory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SearchAndReplaceInStory rngstory, ListArray
' Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range, ByRef
ListArray As Variant)
ResetFRParameters
Dim i As Long
Dim myString As String
For i = LBound(ListArray) To UBound(ListArray)
'Strip the "speech marks" from the find text
myString = ListArray(i)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.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
Sub ResetFRParameters()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End Sub
 
G

Guest

Thanks again Greg, that is much better, we sometimes have very long
definitions and other words within a definition can be emboldened (aswell as
the definition itself).

The only thing which will stop me implementing this now is that it changes
non-exact words.

For example if I had a definition of "Lease" and ran the macro it would also
change all occurrences of "leasehold" to "Leasehold" as well as changing
"lease" to "Lease" which we wouldn't want.

However I shall look over your site and see if I can think of a way to
overcome this problem myself.

Thanks once again for all your brilliant help, I really appreciate it :)
 
G

Greg

Add the following line between

..Replacement.Clearformatting and


Should look like this:
..Replacement.Clearformatting
..MatchWholeWord = True
..Text = my String
 
G

Greg Maxey

markymids,

I went looking for improvements to the code I sent earlier and got some
assistance from G.G. Yagoda in the VBA group. The code below is designed
for what G.G. calls a pretty standard legal document. With a section of
definitions that are quoted and bold. His sample also contains multiword
phrases with constitute a term. I have further adapted the code G.G. and I
passe back and forth. See if this meets your needs:

Public Sub WordMarker()
'Developed by Greg Maxey with input and assistance by G.G. Yagota

Dim rngstory As Word.Range
Dim ListArray
Dim j As Integer
Dim myRange As Range
Dim UserQuotePreference As Boolean
Dim QuotesToggled As Boolean

'Stores users AutoCorrect quotes options
UserQuotePreference = Options.AutoFormatAsYouTypeReplaceQuotes

Set myRange = ActiveDocument.Range
j = 0
QuotesToggled = False

'Replace curly quotes with straight quotes!!!
If MsgBox("You must convert curly quotes for this operation." _
& " Curly quotes will be restored while processing. " _
& " Are curly vice straight quotes used to bracket" _
& " defined phrases?", vbYesNo) = vbYes Then
Options.AutoFormatAsYouTypeReplaceQuotes = False
QuotesToggled = True
For Each rngstory In ActiveDocument.StoryRanges
Do
If rngstory.StoryLength >= 2 Then
CurlyQuoteToggle rngstory
End If
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
End If
Do
With myRange.Find
'Each defined word must be preceeded by a paragraph mark.
'Find phrases and build phrase list
.Text = Chr(13) & """*"""
.MatchWildcards = True
.Execute
If myRange.Font.Bold Then
myRange.Start = myRange.Start + 2
myRange.End = myRange.End - 1
Select Case myRange.Text
Case Is <> ""
myRange.Text = Trim(myRange.Text)
ListArray = ListArray & myRange.Text & "|"
j = j + 1
End Select
End If
myRange.End = myRange.End + 1
myRange.Start = myRange.End
End With
Loop While myRange.Find.Found
ListArray = Left(ListArray, Len(ListArray) - 1)
'Establish array
ListArray = Split(ListArray, "|")
MsgBox ("Document contains " & j & " definded terms/phrases")
MakeHFValid
Application.ScreenUpdating = False
For Each rngstory In ActiveDocument.StoryRanges
Do
If rngstory.StoryLength >= 2 Then
SearchAndReplaceInStory rngstory, ListArray
End If
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
'Reapply curly quotes
If QuotesToggled = True Then
Options.AutoFormatAsYouTypeReplaceQuotes = True
For Each rngstory In ActiveDocument.StoryRanges
Do
If rngstory.StoryLength >= 2 Then
CurlyQuoteToggle rngstory
End If
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
Options.AutoFormatAsYouTypeReplaceQuotes = UserQuotePreference
End If
Application.ScreenUpdating = True
Application.ScreenRefresh
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range, ByRef
ListArray As Variant)
Dim i As Long

For i = LBound(ListArray) To UBound(ListArray)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = False
.MatchWholeWord = True
.Text = ListArray(i)
.Replacement.Text = ListArray(i)
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll
End With
Next i
End Sub
Public Sub MakeHFValid()
Dim lngJunk As Long
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
End Sub
Sub CurlyQuoteToggle(ByVal rngstory As Word.Range)
With rngstory.Find
.Text = Chr$(34)
.Replacement.Text = Chr$(34)
.Wrap = wdFindContinue
.Forward = True
.Format = False
.MatchCase = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top