Vba 如何在Word中复制对活动列表编号的引用？

我的文档中有很多列表，它们的编号类似于“1.3.2”，我希望自动化创建列表元素交叉引用的过程

我正在尝试制作一个宏，它将：

• 检测列表元素，光标位于
• 创建对列表元素的交叉引用，将数字作为引用文本（即“1.3.2”）
• 把它放到剪贴板上
• 当光标位于列表编号时，使“LCtrl+C”热键启动该宏（可选：仅适用于具有声明样式的列表）

---

我如何使用VBA实现这一点？

我已经为它的乐趣和长话短说做了很多修改：我认为你不会做到这一点。原因：这是用于在VBA中创建对编号项目的交叉引用的代码：

Set r = Selection.Range

r.InsertCrossReference ReferenceType:="Numbered item", _
        ReferenceKind:=wdNumberRelativeContext, ReferenceItem:="5", _
        InsertAsHyperlink:=True, IncludePosition:=False, SeparateNumbers:=False, _
        SeparatorString:=" "

这里的问题是ReferenceItem:=“5”。当我录制这段视频时，它只是第五个编号的项目，无论其列表级别如何。 因此，您现在要做的就是找到一种方法，将一个编号项目标识为文档中的第n个编号项目

如果可以解决此问题，则可以指定一个组合键来复制对当前列表项的引用，如下所示：

Sub CopyReference()
Dim r As Range
Dim dObject As DataObject

Set dObject = New DataObject

Set r = Selection.Range

r.InsertCrossReference ReferenceType:="Nummeriertes Element", _
        ReferenceKind:=wdNumberRelativeContext, ReferenceItem:="5", _
        InsertAsHyperlink:=True, IncludePosition:=False, SeparateNumbers:=False, _
        SeparatorString:=" "

dObject.SetText r.Paragraphs(1).Range.Fields(1).Code
r.Paragraphs(1).Range.Fields(1).Delete
dObject.PutInClipboard

End Sub

Sub pasteField()
Dim fld As Field, dObject As DataObject
Dim gg

Set fld = ActiveDocument.Fields.Add(Selection.Range, wdFieldRef)
Set dObject = New DataObject
dObject.GetFromClipboard
gg = dObject.GetText
fld.Code.Text = gg
fld.Update
End Sub

和另一个组合键来粘贴参考，如下所示：

Sub CopyReference()
Dim r As Range
Dim dObject As DataObject

Set dObject = New DataObject

Set r = Selection.Range

r.InsertCrossReference ReferenceType:="Nummeriertes Element", _
        ReferenceKind:=wdNumberRelativeContext, ReferenceItem:="5", _
        InsertAsHyperlink:=True, IncludePosition:=False, SeparateNumbers:=False, _
        SeparatorString:=" "

dObject.SetText r.Paragraphs(1).Range.Fields(1).Code
r.Paragraphs(1).Range.Fields(1).Delete
dObject.PutInClipboard

End Sub

Sub pasteField()
Dim fld As Field, dObject As DataObject
Dim gg

Set fld = ActiveDocument.Fields.Add(Selection.Range, wdFieldRef)
Set dObject = New DataObject
dObject.GetFromClipboard
gg = dObject.GetText
fld.Code.Text = gg
fld.Update
End Sub

---

正如您所见，我实际上并没有复制交叉引用字段，只是复制了它的代码。

在查看了对象模型和Word的行为后，我认为您可以管理一些东西，但可能不是您想象的那样。问题在于编号的项目，它们似乎指向标题而不是编号的行。。。在任何情况下，当通过对话框将交叉引用插入“编号项目”时，Word都会创建书签，然后引用该书签。因此，我的建议模拟了这种行为，如下面的代码片段所示

您需要/想要做的是维护一个“计数器”来递增书签名称（或者您可以像Word那样生成GUID）。我的演示带有硬编码的书签名称

本例在当前选定内容所在段落的开头设置隐藏书签。然后插入交叉引用，扩展范围以包含交叉引用（因为该方法不返回范围或对象），并将其剪切到剪贴板。然后用户可以将其粘贴到任何他想要的地方

Sub InsertThenCopyCrossRef()
    Dim rng As word.Range, rngBkm As word.Range
    Dim bkm As word.Bookmark
    Dim sMyRef As String

    sMyRef = "_MyRef_1" 'a counter or something to make name unique!
    Set rng = Selection.Range
    Set rngBkm = rng.Duplicate.Paragraphs(1).Range
    rngBkm.Collapse wdCollapseStart
    Set bkm = ActiveDocument.Bookmarks.Add(sMyRef, rngBkm)
    rng.InsertCrossReference wdRefTypeBookmark, wdNumberFullContext, sMyRef
    rng.MoveEnd wdWord, 1
    rng.Fields(1).Cut
    'rng.Select
End Sub

---

不确定我是否理解：“创建交叉引用”-您希望在哪里创建交叉引用？您正处于引用所指向的目标。您希望源链接位于何处？创建交叉引用本身就像打开宏记录器一样简单。。。请准确指定所需内容，包括预期输出和迄今为止尝试的内容。我想在剪贴板（GeneratedReference.PutInClipboard）中创建它。用例：单击列表编号Ctrl-C，单击要将交叉引用粘贴到该列表元素的任何位置，Ctrl-V，列表元素编号将作为交叉引用粘贴到该位置。这与“交叉引用”无关。您可以使用

DataObject

和

.SetText

将文本复制到剪贴板，如下所示：并使用

Selection.parages（1）.Range.ListFormat

获取当前参数图的列表号。我想做与交叉引用窗口相同的事情，当您选择引用类型“编号项目”并插入对“段落编号”（）的引用时，但在没有窗口的情况下执行此操作，并在剪贴板中插入交叉引用，而不是直接插入文档。文档的列表太多，因此很难使用该窗口。如果我们只使用热键复制粘贴它们，这将节省大量时间。是的，我试图模拟窗口逻辑，但您的解决方案正是我所需要的。我刚刚添加了timestamp作为新引用的UID:sMyRef=“MyRef”和DateDiff（“s”，“1/1/1970”，“Now（）），并在此行中添加了InsertAsHyperlink:=True:rng.InsertCrossReference wdRefTypeBookmark，wdNumberFullContext，sMyRef，True，非常感谢！是的，带书签可能更好。伤口也有用吗？我试的时候没有。我确实打开了一个RDP，它可能会弄乱我的剪贴板，但复制和剪切在字段中对我不起作用。@是的，剪切有效。当它添加一行文本并立即删除它时，看起来有点奇怪，但它确实做到了。为列表元素创建书签的方法比使用标准窗口工程师要好得多。你的代码使用的是PutInClipboard而不是cut，据我所知，你只接受文本，而不是字段？@Cindymister是的。正如我所说，由于某些原因，它无法正确复制字段，粘贴将不会产生任何结果。所以我创建了一个临时交叉引用，将字段代码复制到剪贴板。然后，第二个代码创建一个新字段，并将字段代码设置为剪贴板内容。长篇大论，但它根本没有抄袭我可能尝试的领域。