选择一个交叉参考项目

Question

给定编号项目的文本，我需要插入对特定编号项目的交叉引用（来自简单编号列表）。 用户选择要交叉引用的列表项以及插入交叉引用的位置，如下所示：

1. This is item 1
2. This is item 2  <-- user selects this line
3. This is item 3
------------------
[2]  This is a reference to item 2  <-- user ctrl selects this line too
 ^ macro will insert the 2 as a cross reference to the selected list item

但是，可以有许多带相同文本的编号项目，因此我需要一种方法来确定选择哪个项目。 我计划选择每个具有正确文本的项目，检查它是否在文档中的正确位置，以及现在是否知道它的“ ReferenceItem：”数字，以便可以插入对其的交叉引用。 我遍历以下结果：

ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem)

以获得带有正确文本的编号项目的参考编号，但我不知道如何选择每个候选项目，因此可以测试其位置。 就像是：

ActiveDocument.Goto.CrossReferenceItem(81)

这是在Word 2010中。

代码示例（删除了所有错误检查）：

'Create a temporary character style
ActiveDocument.Styles.Add "_TEMP_STYLE_", wdStyleTypeCharacter

'Apply the temporary style to the discontiguous selection
Selection.Style = ActiveDocument.Styles("_TEMP_STYLE_")

Set olRange = ActiveDocument.Range

With olRange.Find
    .ClearAllFuzzyOptions
    .ClearFormatting
    .ClearHitHighlight
    .Style = ActiveDocument.Styles("_TEMP_STYLE_")
    .Text = ""
    .Wrap = wdFindStop

    'llNumberedParaStart is used in the check of a numbered item to see if it is
    'the right one 
    llNumberedParaStart = -1
    llChildParaStart = -1

    Do While .Execute
        If .Found Then
            If olRange.Paragraphs(1).Range.ListFormat.ListType = wdListSimpleNumbering Then
                llNumberedParaStart = olRange.Characters(1).Start
                ' Do some work before this to get the text to check for
                slNumberedParaText = Selection.Text
            Else
                llChildParaStart = olRange.Characters(1).Start
            End If
    Loop
End With

slaNumItems = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem)

'Loop through all the numbered items and find the correct one
For ilRefItem = 0 To UBound(slaNumItems)

    If InStr(slNumberedParaText, slaNumItems(ilRefItem)) = 0 Then

        'Check to make sure the reference is the correct one
        ********** select the numbered item and check its position **********

        'Insert the cross reference after selecting the correct location
        Selection.InsertCrossReference ReferenceType:="Numbered item", _
             ReferenceKind:=wdNumberRelativeContext, ReferenceItem:=ilRefItem, _
             InsertAsHyperlink:=True, IncludePosition:=False, SeparateNumbers:=False, _
             SeparatorString:=" "        

        Exit For

    End If
Next ilRefItem

Answer 1

此maro解析所有类型为“ wdRefTypeHeading”的交叉引用项目，并将其段落编号与当前选定的段落编号进行比较：如果它们匹配，则将文本插入点移动到上方一行，并添加以下文本：

§xxx，第yyy页

其中xxx和yyy当然是段落号和页码。

然后将文本剪切并放入剪贴板，因此原始文档不受影响。

注意：标题之前必须有一个空行，否则以上行的所有内容都会被剪切掉。

Sub CreaRiferimento()
    Dim d As Document
    Set d = ActiveDocument
    Debug.Print "Current selection: " & Selection.Paragraphs(1).Range.ListFormat.ListString & " " & Selection.Paragraphs(1).Range
    n = GetRefNum()
    Debug.Print "Internal reference number = " & n

    ' Sposta punto inserimento sopra a titolo
    Selection.MoveUp Unit:=wdLine, Count:=1

    ' Scrive "§"
    Selection.TypeText Text:="§"

    ' Scrive riferimento a paragrafo
    Selection.InsertCrossReference ReferenceType:="Titolo", ReferenceKind:= _
        wdNumberRelativeContext, ReferenceItem:=Trim(Str(n)), InsertAsHyperlink:=True, _
        IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "

    ' Scrive "p." per la pagina
    Selection.TypeText Text:=", p."

    'Scrive riferimento a pagina del paragrafo
    Selection.InsertCrossReference ReferenceType:="Titolo", ReferenceKind:= _
        wdPageNumber, ReferenceItem:=Trim(Str(n)), InsertAsHyperlink:=True, _
        IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "

    ' Taglia in clipboard quanto appena scritto
    Selection.EndKey Unit:=wdLine
    Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    Selection.Cut

  End Sub

Function GetRefNum() As String
    CRI = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
    HeadNum = Selection.Paragraphs(1).Range.ListFormat.ListString
    CRINumber = 1
    For Each CR In CRI
        HeadingNumberFromFunction = Mid$(LTrim(CR), 1, InStr(LTrim(CR), " ") - 1)
        'Debug.Print HeadNum & " ? " & HeadingNumberFromFunction
        'Debug.Print "'" & CR & " ' = ReferenceItem n." & CRINumber
        If HeadingNumberFromFunction = HeadNum Then
            GetRefNum = CRINumber
            Exit Function
        End If
        CRINumber = CRINumber + 1
    Next

End Function