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，p.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

选择交叉参考项目

1 个答案: