#16
|
|||
|
|||
Hi Slaycock.
i have tried the code with your sample text above and it works. All the errors which had been highlighted/commented in your screenshot have appeared in my word document. However when i try it with an existing document/contract, the bugs occur. Perhaps it can't work with .doc files or documents which were created with another normal.dotm? |
#17
|
|||
|
|||
The macro should work with .doc files. Are you able to share a document?
|
#18
|
|||
|
|||
Thanks for for forwarding a sample document. The complexity of the task increased quite a bit as your defined terms contain lots of definitions that are not capitalized words.
The code currently 1. Changes the text to red for the first ocurrence of a defined term. 2. Adds a comment to each duplicate defined term 3. Adds a comment if a defined term does not have a closing " (Can't guarantee 100% success on this) 4. Creates a separate document of all the defined terms with a column of true or false. False means that the defined term is not used in the document. Your wish of having Capitalized words which are not defined terms highlighted is too complex at the moment (hence the definitions document). Code:
Option Explicit ' Vetted by Rubberduck http://rubberduckvba.com/ Public Const open_quote As String = "("")" ' Smart quote entered using ALT+0147 Public Const close_quote As String = """" ' Smart quote entered using ALT+0148 Public Const capitalised_word As String = "([$£A-Za-z€])([0-9A-Za-z]{1,})" ' Any sequence of characters starting with a Capital letter Public Const definition_other_chars As String = " ''(),-:;[\]`ofs–—" Public search_doc As Word.Document Public quoted_definitions As Object Public Sub annotate_definitions_in_a_doc() Application.ScreenUpdating = False Set search_doc = ActiveDocument Set quoted_definitions = CreateObject("Scripting.Dictionary") compile_list_of_quoted_definitions check_that_definitions_are_used highlight_unused_definitions create_definitions_document Application.ScreenUpdating = True End Sub Private Sub create_definitions_document() Dim my_definitions_doc As Word.Document Dim my_definition As Variant Dim my_definitions As Variant Set my_definitions_doc = Documents.Add my_definitions = quoted_definitions.keys For Each my_definition In my_definitions my_definitions_doc.Content.InsertAfter Text:=my_definition & vbTab & quoted_definitions.Item(my_definition) & vbCrLf Next my_definitions_doc.Content.Select Selection.ConvertToTable Separator:=wdSeparateByTabs With Selection.Tables(1) .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False End With my_definitions_doc.SaveAs2 Replace(search_doc.FullName, ".do", "_definitions.do") End Sub Private Sub compile_list_of_quoted_definitions() Dim search_range As Word.Range Dim found_range As Word.Range Set search_range = search_doc.StoryRanges(wdMainTextStory) With search_range With .Find .ClearFormatting .Replacement.ClearFormatting .MatchWildcards = True .Wrap = wdFindStop .Text = open_quote & capitalised_word .Execute End With Do While .Find.Found DoEvents Set found_range = .Duplicate update_search_range_to_whole_capitalised_phrase found_range do_actions_for_quoted_text found_range .Collapse direction:=wdCollapseEnd .Move unit:=wdCharacter, Count:=1 .Find.Execute Loop End With End Sub Private Sub do_actions_for_quoted_text(ByRef this_range As Word.Range) this_range.Select ' Check to see if a definition we have just found already exists If quoted_definitions.Exists(this_range.Text) Then search_doc.Comments.Add Range:=this_range, Text:="Duplicate definition?" Exit Sub End If quoted_definitions.Add Key:=this_range.Text, Item:=True this_range.Font.ColorIndex = wdRed End Sub Private Sub update_search_range_to_whole_capitalised_phrase(ByRef this_range As Word.Range) ' The found range starts with a double quote which we don't need ' so move the start of the range past the double quote this_range.MoveStart unit:=wdCharacter ' We only searched for alpha characters after the opening quote ' is the next character a double quote If this_range.Characters.Last.Next.Text = close_quote Then Exit Sub End If ' the next character is not a quote so we need to check if it is a ' non alpha character that can be included in a definition or a capital ' if not then add comment about incorrect definition Do DoEvents ' " (),-:;[\]`of–—" If Not ( _ (InStr(definition_other_chars, this_range.Characters.Last.Next.Text) > 0) _ Or (this_range.Characters.Last.Next.Text Like "[A-Za-z]")) _ Then this_range.Comments.Add this_range, "Definition missing closing quote" Exit Sub End If ' The next character is legal so look for the next word ' first skip over any permitted non-alpha characters this_range.MoveEndWhile cset:=definition_other_chars 'Check for Capital or double quote If this_range.Characters.Last.Next.Text Like "[!""0-9A-Za-z]" Then this_range.Comments.Add this_range, "Definition missing closing quote" Exit Sub End If this_range.MoveEnd unit:=wdWord Loop Until this_range.Characters.Last.Next = """" End Sub Private Sub check_that_definitions_are_used() Dim definition As Variant Dim definitions As Variant Dim search_range As Word.Range ' We can now use the scripting.dictionary of defined terms to check if they ' actually occur in the document ' if we don't find a definition used in the document then the item value ' of the definition in the dictionary will be set to false. definitions = quoted_definitions.keys For Each definition In definitions DoEvents Set search_range = search_doc.StoryRanges(wdMainTextStory) With search_range.Find .ClearFormatting .Replacement.ClearFormatting .MatchWildcards = True .MatchCase = True .Wrap = wdFindStop .Text = definition .Execute If Not .Found Then quoted_definitions(definition) = False End If End With Next End Sub Private Sub highlight_unused_definitions() Dim definition As Variant Dim definitions As Variant Dim search_range As Word.Range Dim search_text As String Dim replace_text As String replace_text = "[\1\2]" definitions = quoted_definitions.keys For Each definition In definitions DoEvents If Not quoted_definitions(definition) Then Set search_range = search_doc.StoryRanges(wdMainTextStory) search_range.Select search_text = "(" & open_quote & ")" & "(" & definition & ")" With search_range.Find .ClearFormatting .Replacement.ClearFormatting .MatchWildcards = True .Wrap = wdFindStop .Text = search_text .Replacement.Text = replace_text .Replacement.Highlight = True .Execute Replace:=wdReplaceOne Set search_range = Nothing ' if preferred you could add here the code to add a comment rqather than highlight the text End With End If Next End Sub |
#19
|
|||
|
|||
A few questions and comments
Hey I know this thread is kind of old, but I'm trying get this macro working, as it would be very helpful to me. Has anybody had any of these issues:
1. Macro seems to complete correctly when the definitions are wrapped in straight quotes, but when smart quotes wrap the definitions, the definitions file is empty and none of the quoted terms have been turned red. 2. Perhaps this search logic would be too complicated, but it seems like the current logic doesn't account for definitions that might have a period or comma inside the quote (e.g., There are two terms: "Term 1," and "Term 2.") In those cases , the search thinks that the definition is missing closing quote and makes a comment. 3. I'm a little unclear about how I would use the definitions file (or some other external file) to search for instances of the definition that are not capitalized. Should I be looking for a different macro to accomplish that. 4. For anyone else who is confused about how to engage this macro sequence, you want to start with this macro: "annotate_definitions_in_a_doc" This macro is actually a series of different macros. If it's they are the only macros in your module, they'll sort in alpha order, with each macro contiguous to the one before it and their relationship will make sense. But if you've got a bunch of other macros, the various macros in this sequence will be interspersed within a large alpha order. For a relative newbie, like myself, this was confusing, because I was used to a macro being a singular script, not a series of different ones linked together in a chain. I'm sure this is a smart way to build something like this. It was just a little confusing. I use a couple of word add-ins that run word macros, and it looks like those developers pre-fix each of their scripts with an abbreviation like TFT, so all of the related scripts sort together in one place. Anyway, I'm sure all of this obvious to experienced people, but for anybody who isn't perhaps it will help you get up and running with what seems like a great macro if you need this functionality. TIA for any help on this! KS |
#20
|
|||
|
|||
Oops. Answering one of my own questions about the smart quotes:
It's explained here I believe: Code:
Public Const open_quote As String = "("")" ' Smart quote entered using ALT+0147 Public Const close_quote As String = """" ' Smart quote entered using ALT+0148 Seems like the other quesiton/comment I had above about commas, period, etc. is perhaps also addressed in one of these public constants, but I'm not sure I have it configured correctly. KS |
#21
|
||||
|
||||
I haven't studied the code, but the comments already tell you what you should input. For example:
Code:
Public Const open_quote As String = "("")" Code:
Public Const open_quote As String = "“" Code:
Public Const close_quote As String = """" Code:
Public Const close_quote As String = "”"
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro that deletes unused styles | thejollyroger | Word VBA | 14 | 12-04-2017 09:00 AM |
Best Practice for Indexing Multiple Word Terms and Sub-Terms | jhy001 | Word | 4 | 11-06-2017 02:08 PM |
Macro Question: Need help making a macro to highlight the first word in every sentence | LadyAna | Word | 1 | 12-06-2014 10:39 PM |
Wild card to highlight capitalised terms? | bertietheblue | Word | 2 | 02-08-2013 04:44 PM |
find - reading highlight - highlight all / highlight doesn't stick when saved | bobk544 | Word | 3 | 04-15-2009 03:31 PM |