Word VBA-제목 번호 참조 삽입 방법; 제목 텍스트; 댓글 목록 항목 번호 및 목록 항목 페이지 번호?

Word 문서에서 특정 텍스트를 표시하고 다양한 참조가있는 주석을 추가하고 싶습니다. 이는 a) 추가 처리를 위해 주석에 해당 세부 정보를 출력 / 인쇄 할 수 있고 b) 문서가 개발되고 변경되면 주석 정보가 업데이트되도록하기위한 것입니다.

주석에 포함하고 싶은 참조는 다음과 같습니다.

• 텍스트 (단어 또는 문장 등)가 속한 표제 번호
• 표제 텍스트
• 단락 번호-> 이것은 각각의 새 제목으로 다시 시작되는 두 열 표의 첫 번째에있는 번호가 매겨진 목록 항목입니다 (단락 텍스트는 오른쪽 열에 있음).
• 단락의 페이지 번호-> 따라서 목록 항목 페이지 번호입니다.

텍스트는 다음과 같습니다.

1.0 제목 A 텍스트

이것은 문서의 1 페이지입니다.

1.1 제목 B 텍스트

1.1.1 제목 C 텍스트

이 제목으로 2 페이지 시작

2.0 제목 D 텍스트

2.1 제목 E 텍스트

2.1.1 제목 F 텍스트

원하는 결과는 "임의"라는 단어에 대한 다음 예제와 같이 선택한 단어 / 텍스트에 대해 MS Word 풍선 주석이 삽입 된 경우입니다.

임의 ----> (섹션 1.1.1 제목 C 텍스트, 단락 [2], 페이지 2)

나는 이미 대부분, 즉 단락 / 목록 항목 번호와 단락 페이지 번호를 제외한 모든 참조 (지금 사용하는 페이지 번호는 제목의 페이지 번호)를 추출했습니다.

이것이 내가 지금까지 가지고있는 것입니다.

Sub InsertCommentWithReferences()

    Dim rng As Range
    Dim iLevel As Integer
    Dim sLevel As String
    Dim mystring As String
    Dim RefList As Variant
    Dim row As Integer
       
    Dim Message, Title, Default, myrequirement
    
    'To hand over additional (requirement)text to be inserted at the beginning of the comment
    'Message = "Enter the requirement number"    ' Set prompt.
    'Title = "Requirement number"    ' Set title.
    'Default = ""    ' Set default.
    'Display message, title, and default value.
    'myrequirement = InputBox(Message, Title, Default)
       
    Set rng = Selection.Range
    
    iLevel = rng.Paragraphs(1).OutlineLevel
    sLevel = "0"
    
    mystring = Selection
    sLevel = rng.ListFormat.ListString
        
    ' Collapse the range to start so as to not have to deal with '
    ' multi-segment ranges. Then check to make sure cursor is '
    ' within a table. '
    Selection.Collapse Direction:=wdCollapseStart
    If Not Selection.Information(wdWithInTable) Then
        MsgBox "Can only run this within a table"
        Exit Sub
    End If
    
    ' lookup paragraph number as a text string
    ' Here I do actually extract the paragraph number but just as string and not as a reference
    ' which can be updated if the numbering changes
    row = Selection.Information(wdEndOfRangeRowNumber)
    Selection.Tables(1).Cell(row, -1).Select
    paragraphstring = Selection.Paragraphs(1).Range.ListFormat.ListString
    'MsgBox (paragraphstring)
    
  
    Set rng = Selection.GoToPrevious(wdGoToHeading)
    If rng.Paragraphs(1).OutlineLevel < iLevel Then
        iLevel = rng.Paragraphs(1).OutlineLevel
        Set rng = rng.Bookmarks("\line").Range
        curr_headinglevel = rng.Paragraphs(1).OutlineLevel
        curr_headingnumber = Selection.Paragraphs(1).Range.ListFormat.ListString
        curr_headingtext = rng
    End If

    With Selection.Find
        .ClearFormatting
        .MatchWholeWord = True
        .MatchCase = False
        .Execute FindText:=mystring
    End With

    Selection.Comments.Add Range:=Selection.Range
      
    temp = curr_headingnumber & " " & curr_headingtext
    If Right(temp, 1) = vbCr Then
        temp = Left(temp, Len(temp) - 1)
    End If
      
      
    myHeadings = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
    For i = 1 To UBound(myHeadings)
        'debug
        'MsgBox (Trim(myHeadings(i)) & vbNewLine & temp)
        If InStr(Trim(myHeadings(i)), "  ") Then
            'debug
            'MsgBox ("double space")
            Do
                temp1 = myHeadings(i)
                myHeadings(i) = Replace(myHeadings(i), Space(2), Space(1))
            Loop Until temp1 = myHeadings(i)
        End If
        
        If InStr(Trim(myHeadings(i)), temp) Then
        
            'debug stuff
            'tempheading = myHeadings(i)
            'MsgBox ("#" & tempheading & "#")
            'If Left(tempheading, 1) = " " Then
            '    tempheading = Trim(tempheading)
            'End If
                  
            
            'Selection.TypeText Text:=("R# " & myrequirement & vbNewLine & "Section ")
            Selection.TypeText Text:=("R#" & myrequirement & "#Section ")
            
            Selection.InsertCrossReference ReferenceType:="Heading", _
                ReferenceKind:=wdNumberFullContext, _
                ReferenceItem:=CStr(i), _
                InsertAsHyperlink:=True, _
                IncludePosition:=False, _
                SeparateNumbers:=False, _
                SeparatorString:=" "
            
            Selection.TypeText Text:=(" ")
            
            Selection.InsertCrossReference ReferenceType:="Heading", _
                ReferenceKind:=wdContentText, _
                ReferenceItem:=CStr(i), _
                InsertAsHyperlink:=True, _
                IncludePosition:=False, _
                SeparateNumbers:=False, _
                SeparatorString:=" "
                                           
            Selection.TypeText Text:=("; Paragraph " & paragraphstring)
            
            Selection.TypeText Text:=("; Page ")
            
            Selection.InsertCrossReference _
                ReferenceType:=wdRefTypeHeading, _
                ReferenceKind:=wdPageNumber, ReferenceItem:=i
            
        End If
        'debug
        'MsgBox (temp & "#")
    Next i
    
    Set rng = Nothing

End Sub

도움이 필요한 것은 각 목록 항목 / 단락 번호의 참조를 식별하고 주석에 삽입하는 방법입니다. 즉, 다음과 같은 줄을 따라야합니다. 왼쪽 셀을 살펴보고 해당 셀에서 찾을 수있는 목록 항목 / 단락 번호를 가리키는 참조를 주석 (번호 및 페이지 번호)에 삽입합니다.

예에서 볼 수 있듯이 항목 번호는 반복 될 수 있으며 (새 제목마다 번호 매기기 다시 시작) 제목처럼 목록 항목 텍스트가 없으므로 해당 텍스트를 검색 할 수 없습니다.

모든 힌트를 많이 주시면 감사하겠습니다. VBA에 대한 경험이 많지 않으며 위의 내용은 다른 많은 Q & A 스레드의 다양한 다른 예제에서 수집되었습니다.

정말 고마워.

안부 인사, 마이클.