Word VBA调用GetCrossReferenceItems获取含空格自定义题注失败问题

问题根因 #

• 这是Word VBA GetCrossReferenceItems 方法的已知缺陷：该方法无法正确识别名称包含空格的自定义题注标签，传入带空格的标签名称会返回空或者无正常结果。
• 你写的ReferenceType = "Figure A"不是正确的命名参数传值写法：这行代码本质是布尔表达式运算，VBA会先判断未初始化的变量ReferenceType是否等于"Figure A"，结果为False，等价于向ReferenceType参数传入了0，因此方法返回所有类型的交叉引用项，而非筛选后的结果。

解决方案 #

方案1：传题注标签的索引值代替名称（最简便） #

GetCrossReferenceItems方法的ReferenceType参数支持传入题注标签的索引值，不受标签名称是否带空格的影响。你可以先获取「Figure A」对应的题注标签索引，再传入方法即可：

Sub Caption_Example_Fixed()
    ' 先确保题注标签存在
    On Error Resume Next
    CaptionLabels.Add Name:="Figure"
    CaptionLabels.Add Name:="Figure A"
    On Error GoTo 0
    
    ' 原有插入题注代码不变
    With Selection
        .InsertCaption _
            Label:="Figure", _
            Title:=": A fancy title", _
            Position:=wdCaptionPositionBelow, _
            ExcludeLabel:=0
    End With
    Selection = vbCrLf
    With Selection
        .InsertCaption _
            Label:="Figure A", _
            Title:=": Another fancy title", _
            Position:=wdCaptionPositionBelow, _
            ExcludeLabel:=0
    End With
    
    ' 获取普通Figure题注（原有写法不变）
    Dim x As Variant
    x = ActiveDocument.GetCrossReferenceItems(ReferenceType:="Figure")
    Debug.Print "First figure: "; x(1)
    
    ' 获取Figure A题注：先拿对应标签的索引再传入
    Dim figAIndex As Integer
    figAIndex = CaptionLabels("Figure A").Index
    Dim y As Variant
    y = ActiveDocument.GetCrossReferenceItems(ReferenceType:=figAIndex)
    Debug.Print "First appendix figure: "; y(1)
    
    ' 后续插入交叉引用的代码不受影响，原有写法可正常运行
    Selection.Text = vbCrLf
    Selection.InsertCrossReference _
        ReferenceType:="Figure A", _
        ReferenceKind:=wdOnlyLabelAndNumber, _
        ReferenceItem:="1", _
        InsertAsHyperlink:=True, _
        IncludePosition:=False, _
        SeparateNumbers:=False, _
        SeparatorString:=" "
End Sub

方案2：自行遍历题注生成数组（兼容性更强） #

如果需要完全规避方法本身的问题，可以遍历文档所有题注字段自行筛选：

Function GetCaptionItems(labelName As String) As Variant
    Dim arr() As String
    Dim cnt As Long: cnt = 0
    Dim fld As Field
    
    ReDim arr(1 To ActiveDocument.Fields.Count)
    For Each fld In ActiveDocument.Fields
        If fld.Type = wdFieldSequence Then
            ' 提取Sequence域的标签名
            Dim fldCode As String: fldCode = fld.Code.Text
            If InStr(fldCode, "SEQ " & labelName & " ") > 0 Then
                cnt = cnt + 1
                ' 可根据需要拼接标签+编号+标题
                arr(cnt) = fld.Result.Text & " " & fld.Next.Range.Text
            End If
        End If
    Next
    If cnt > 0 Then
        ReDim Preserve arr(1 To cnt)
        GetCaptionItems = arr
    End If
End Function

' 调用示例：
' y = GetCaptionItems("Figure A")

内容的提问来源于stack exchange，提问作者Poza