View Single Post
 
Old 11-09-2020, 11:22 AM
rekent rekent is offline Windows 7 64bit Office 2010
Novice
 
Join Date: May 2014
Posts: 22
rekent is on a distinguished road
Default

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
Attached Files
File Type: docx PreferencesDocument.docx (11.9 KB, 5 views)
File Type: docx DocumentToCheck.docx (12.3 KB, 5 views)
Reply With Quote