|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Insert Comments from List for Whole Document and for Only Selected Portion of Document
I am trying to write a macro that enables me to do the following things:
1. Open an UI element and select an option. 2. Search an open document for keywords based on the selected option, where the keywords (or phrases) are located in a separate file with a carriage return between each and the keywords are highlighted in the open document. 3. Add comments from a different user name to some of the located keywords, where the comments are unique to each keyword and are located in a separate file in the format "[keyword] Statement related to keyword." 4. Identify and select a portion of the open document that includes numbers in the format "X." 5. Repeat 2 and 3 above for only the selected portion of the document identified in 4. 6. Find a single specific word in the open document, only in all upper case, and add a comment to that word (word and comment hardcoded, not found in external file). I have steps 1 and 2 complete and functioning. I know how to change the username for step 3 and how to add comments generally through VBA, but I do not know how to add them unique to the particular keyword that was found (e.g., keyword1:comment1; keyword2:comment2; keyword3:no comment; keyword4:comment4; etc.) based on a listing in an external file. I also am not certain about how to do steps 4 and 5. I can do step 6 in all regards other than limiting the search to only finding instances of the specific word that are in all capital letters, but I suspect that is likely something trivial to add as a style modifier to the search. I'm not looking for someone to just write the code for me (though I also wouldn't object since I learn well from examples and working backwards). I've learned a lot already in the parts of the code that I have working and would like to try to figure this out at least semi on my own, but I realize that I am at the outer limits of my ability and am hoping for some input and direction to help me with the above points that have me stumped, especially with respect to step 4. That step has me all-around stumped, including how to set up my external file of keywords and external file of comments so that the keywords and comments for steps 2 and 3 are not used in step 4 and vice versa. I don't know if the code that I have for part 2 would be helpful, but I can post it if needed. |
#2
|
||||
|
||||
#4, see https://www.msofficeforums.com/word-...ding-text.html
Post sample docs and/or the code you have already come up with to get focused advice.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
Ok, below is the VBA code that I am working with. The active document that should be open and against which the macro is run is DocumentToCheck.docx and is attached. The document with preferences for use in checking the above document is PreferencesDocument.docx and is also attached.
I am still struggling with 2 aspects: 1) I identify the various keywords in the document and highlight them. Each identified and highlighted instance of "keyword1" should have a comment added that contains "Rule associated with keyword1." If there is no rule, such as for keyword2, no comment should be added for that keyword. Currently, a rule with no content is being added for keyword2 and all comments are being stacked on the very first found instance of keyword1 rather than being properly added to their respective keywords. This could go in a different module and be called if it is going to make the initial module too lengthy or difficult to easily wade through, or otherwise simplifies things. 2) In the PreferencesDocument, there is a section of keywords and rules under a heading "LIST_RULES". I need the macro to ignore that heading and not search for it. Then, in DocumentToCheck I have a numbered list under the heading "LIST". I need to search only the numbered list portion of the DocumentToCheck for the keywords and rules under the heading LIST_RULES. This means that in addition to a new search and comment routine for this section of the document, somehow the existing search will have to be set to ignore or exclude the keywords and rules appearing after LIST_RULES because I do not want to search the remainder of DocumentToCheck for those specific keywords and rules. This also could go in a different module and be called if it is going to make the initial module too lengthy or difficult to easily wade through, or otherwise simplifies things. For 1) I have a general idea of a direction and a start because the comments are being added, they just aren't being added in the correct place. For 2) I am completely lost and am hoping for some insight from someone much more skilled than I. Code:
Sub Highlight() Application.ScreenUpdating = False Dim strCheckDoc As String Dim docRef As Document Dim docCurrent As Document Dim wrdRef As String Dim wrdPara As Paragraph Dim strKeyword As String Dim strRule As String Dim cmtRuleComment As Comment strCheckDoc = "[path to file]\PreferencesDocument.docx" Set docCurrent = Selection.Document Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False) docCurrent.Activate Options.DefaultHighlightColorIndex = wdTurquoise With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Replacement.Highlight = True .Replacement.Text = "^&" .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = False End With For Each wrdPara In docRef.Paragraphs wrdRef = wrdPara.Range.Text strKeyword = Split(wrdRef, ";")(0) strRule = Split(wrdRef, ";")(1) If Asc(Left(strKeyword, 1)) > 32 Then With Selection.Find .Wrap = wdFindContinue .Text = strKeyword .Execute Replace:=wdReplaceAll .Execute FindText:=strKeyword End With With Selection.Find If strRule <> "" Then Set cmtRuleComment = Selection.Comments.Add(Range:=Selection.Range, Text:=strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If End With End If Next wrdPara docRef.Close docCurrent.Activate Application.ScreenUpdating = True Exit Sub End Sub |
#4
|
||||
|
||||
I added some structure to both your docs to make the coding more forgiving. In the DocToCheck, I bookmarked the range where your list is. In the PrefsDoc I added tables to restrict the two separate loops more easily. Then the following code should do what you asked.
Code:
Sub Highlight() Application.ScreenUpdating = False Dim strCheckDoc As String, docRef As Document, docCurrent As Document Dim wrdRef As String, wrdPara As Paragraph, strKeyword As String, strRule As String Dim cmtRuleComment As Comment, tbl1 As Table, tbl2 As Table, aRow As Row, aRng As Range Set docCurrent = ActiveDocument strCheckDoc = docCurrent.Path & "\PreferencesDocument1.docx" Debug.Print strCheckDoc Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False) If docRef.Tables.Count > 1 Then Set tbl1 = docRef.Tables(1) Set tbl2 = docRef.Tables(2) End If For Each aRow In tbl1.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = docCurrent.Range With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = False .Text = strKeyword Do While .Execute aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl2.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = docCurrent.Bookmarks("ListArea").Range With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = False .Text = strKeyword Do While .Execute aRng.HighlightColorIndex = wdYellow If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow docRef.Close docCurrent.Activate Application.ScreenUpdating = True Exit Sub End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#5
|
|||
|
|||
Would it be possible to create the bookmark for DocumentToCheck dynamically within the code based on the preceding and following headings? I need to be able to run this without the document including special elements, instead just having the document's normal formatting and structure.
Could the word LIST in uppercase be found, the list ABSTRACT in uppercase be found, a range defined from immediately following the last character of LIST to immediately preceding the first character of ABSTRACT, and then add the bookmark to that range? (Not that I know how to write the code to define the range that I just suggested...) Edit: I think this code should achieve what I describe above (searching up from the bottom of the document), but VBE is not cooperating at the moment. Code:
Dim startPosition As Long, endPosition As Long, listRange As Range Selection.EndKey Unit:=wdStory With Selection.Find .ClearFormatting .Forward = Flase .Format = True .MatchWholeWord = True .MatchCase = True .MatchWildcards = False .Execute FindText:=uCase("ABSTRACT") endPosition = Selection.Range.Start With Selection.Find .ClearFormatting .Forward = False .Format = True .MatchWholeWord = True .MatchCase = True .MatchWildcards = False .Execute FindText:=uCase("LIST") startPosition = Selection.Range.End listRange.SetRange Start:=startPosition, End:=endposition ActiveDocument.Bookmarks.Add Name:="ListArea", Range:=listRange Last edited by rekent; 11-10-2020 at 02:51 PM. |
#6
|
||||
|
||||
Yes it is possible but it is always going to be slightly dodgy because we don't have exposure to your actual documents so we have to make a guess on what pattern is most robust to identify your 'List' area.
Change this line: Set aRng = docCurrent.Bookmarks("ListArea").Range to: Set aRng = GetListRange(docCurrent) and add this function to the module Code:
Function GetListRange(aDoc As Document) As Range Dim aRng As Word.Range, iStart As Long, iEnd As Long Set aRng = aDoc.Range With aRng.Find .ClearFormatting .Wrap = wdFindStop .MatchCase = True .MatchWildcards = False .Text = "LIST" If .Execute Then iStart = aRng.End aRng.End = aDoc.Range.End .Text = "ABSTRACT" If .Execute Then iEnd = aRng.Start If iEnd > iStart Then Set GetListRange = aDoc.Range(iStart, iEnd) End If End With End Function
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#7
|
|||
|
|||
Quote:
This is just to make the main loop a bit cleaner and easier to follow, correct? |
#8
|
||||
|
||||
Yes. A function allows the main Sub to appear simpler and easier to follow. Ideally Functions reduce the total amount of code required and allow for more easy re-use on different projects.
You could put that code inside the Sub if you wanted to.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#9
|
|||
|
|||
Thank you, Andrew. Works like a charm.
|
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Reveal portion of document based on dropdown selection | chappeja | Word VBA | 1 | 03-27-2019 08:36 PM |
Renumber document at annex portion of document | jeffreybrown | Word | 3 | 02-14-2019 05:53 AM |
How do you add XML Schema Tags to Certain portion of a Word Document? | Anishgirijan | Word VBA | 0 | 02-08-2017 10:38 PM |
How can I link a portion of a word document to another word document and have it auto update? | __Data | Word | 1 | 06-30-2015 11:03 PM |
Save as PDF only saves portion of document | pandro | Word | 0 | 10-08-2014 06:54 AM |