Home |
Search |
Today's Posts |
#1
![]() |
|||
|
|||
![]()
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? |
#2
![]() |
|||
|
|||
![]()
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.StoryT ype 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. |
#3
![]() |
|||
|
|||
![]()
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 Word MVP FAQ site: http://word.mvps.org Email cannot be acknowledged; please post all follow-ups to the newsgroup so all may benefit. "markymids" wrote in message ... 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? |
#4
![]() |
|||
|
|||
![]()
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? "Greg" wrote: 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.StoryT ype 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. |
#5
![]() |
|||
|
|||
![]()
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.StoryT ype 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 |
#6
![]() |
|||
|
|||
![]()
Greg, you are a star! That is almost working perfectly.
The only problems I can foresee with this a 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 "Greg" wrote: 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.StoryT ype 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 |
#7
![]() |
|||
|
|||
![]()
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.StoryT ype 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 |
#8
![]() |
|||
|
|||
![]()
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 ![]() "Greg" wrote: 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.StoryT ype 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 |
#9
![]() |
|||
|
|||
![]()
Add the following line between
..Replacement.Clearformatting and Should look like this: ..Replacement.Clearformatting ..MatchWholeWord = True ..Text = my String |
#10
![]() |
|||
|
|||
![]()
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.StoryT ype 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 -- Greg Maxey/Word MVP See: http://gregmaxey.mvps.org/word_tips.htm For some helpful tips using Word. markymids wrote: 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 ![]() "Greg" wrote: 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.StoryT ype 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 |
Reply |
Thread Tools | |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Opening a document in a protected form | Microsoft Word Help | |||
Can you save individual document pages as seperate word files? | Mailmerge | |||
Change all caps to initial caps | Microsoft Word Help | |||
Newbie document question please | New Users | |||
Document object in protected form | Tables |