View Single Post
 
Old 01-20-2021, 09:56 AM
gmaxey gmaxey is offline Windows 10 Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

You might have to tinker with this a little but I don't see why you would need a userform. I'm assuming the reference document will always have the seven tables:

Code:
Option Explicit
Private m_oDocCurrent As Document
Sub Test()
  Highlight "Gregory K. Maxey"
End Sub
Sub Highlight(ByRef strUser As String)
Dim strCheckDoc As String, docRef As Document
Dim lngIndex As Long
  Set m_oDocCurrent = ActiveDocument
  strCheckDoc = "D:\strCheckDoc.docx"
  Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False)
  For lngIndex = 1 To docRef.Tables.Count
    Select Case lngIndex
      Case 1: ProcessTable docRef.Tables(1), strUser
      Case 2: ProcessTable docRef.Tables(2), strUser, "BACKGROUND", "SUMMARY|DRAWINGS|DETAILED|CLAIMS|ABSTRACT"
      Case 3: ProcessTable docRef.Tables(3), strUser, "SUMMARY", "DRAWINGS|DETAILED|CLAIMS|ABSTRACT"
      Case 4: ProcessTable docRef.Tables(4), strUser, "DRAWINGS", "DETAILED|CLAIMS|ABSTRACT"
      Case 5: ProcessTable docRef.Tables(5), strUser, "DETAILED", "CLAIMS|ABSTRACT"
      Case 6: ProcessTable docRef.Tables(6), strUser, "CLAIMS", "ABSTRACT"
      Case 7: ProcessTable docRef.Tables(7), strUser, "ABSTRACT", "ABSTRACT"
    End Select
  Next lngIndex
  docRef.Close
  m_oDocCurrent.Activate
lbl_Exit:
  Exit Sub
End Sub

Sub ProcessTable(oTbl As Table, strUser As String, _
                 Optional strStartWord As String = vbNullString, Optional strEndWord As String = vbNullString)

Dim oRng As Range, oRngScope As Range
Dim oRow As Row
Dim strKeyword As String, strRule As String
Dim oComment As Comment
Dim arrEndWords() As String
Dim lngIndex As Long
  For Each oRow In oTbl.Rows
    strKeyword = Split(Trim(oRow.Range.Cells(1).Range.Text), vbCr)(0)
    strRule = Split(Trim(oRow.Cells(2).Range.Text), vbCr)(0)
    If strKeyword <> "" Then
      If Not strStartWord = vbNullString Then
        'Process defined sections
        arrEndWords = Split(strEndWord, "|")
        For lngIndex = 0 To UBound(arrEndWords)
          Set oRng = GetDocRange(strStartWord, arrEndWords(lngIndex))
          If Not oRng Is Nothing Then Exit For
        Next lngIndex
      Else
        'Process whole document
        Set oRng = m_oDocCurrent.Range
      End If
      If Not oRng Is Nothing Then
        Set oRngScope = oRng.Duplicate
        With oRng.Find
          .Text = strKeyword
          Do While .Execute
            If Not oRng.InRange(oRngScope) Then Exit For
            oRng.HighlightColorIndex = wdTurquoise
            If strRule <> "" Then
              Set oComment = m_oDocCurrent.Comments.Add(Range:=oRng, Text:=strUser & ": " & strRule)
              oComment.Author = UCase("WordCheck")
              oComment.Initial = UCase("WC")
            End If
          Loop
        End With
      End If
    End If
  Next oRow
End Sub
Function GetDocRange(startWord As String, endWord As String) As Range
Dim oRng As Word.Range, lngStart As Long, lngEnd As Long
  Set oRng = m_oDocCurrent.Range
  With oRng.Find
    .Text = startWord
    If .Execute Then lngStart = oRng.End
    oRng.End = m_oDocCurrent.Range.End
    .Text = endWord
    If .Execute Then lngEnd = oRng.Start
    If startWord = "ABSTRACT" Then lngEnd = m_oDocCurrent.Range.End
    If lngEnd > lngStart Then
      Set GetDocRange = m_oDocCurrent.Range(lngStart, lngEnd)
    End If
  End With
End Function

You have had your hand out quite far here ;-). People do this sort of thing for a living so don't always expect your solutions to be handed to you.
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote