如何修改VBA代码获取Word书签对应段落编号并导入Excel

核心实现逻辑 #

Word VBA 中可通过Paragraphs(1).Range.ListFormat.ListString直接获取指定范围所在段落的纯编号文本，无额外上下文内容，若段落未设置编号则返回空值，完全匹配你需要的无上下文纯段落编号提取需求。

调整后完整代码 #

Sub SectionLocationImportTESTING()
    Dim intDocCount As Integer
    Dim wdApp As Word.Application, wdDoc As Word.Document, xlWb As Excel.Workbook, xlWs As Excel.Worksheet
    Dim BookmarkText As String
    ' 新增变量存储段落编号
    Dim SectionNum As String

    Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0

    If wdApp Is Nothing Then
        MsgBox "没有打开的Word文档。", vbInformation, "无打开的Word文档"
        Exit Sub
    End If

    Set xlWb = ThisWorkbook
    Set xlWs = ActiveWorkbook.Sheets("Data Input")
    intDocCount = wdApp.Documents.Count

    If intDocCount > 1 Then
        MsgBox "当前共打开了 " & intDocCount & " 个Word文档。" & vbNewLine & vbNewLine & _
        "请关闭多余的Word文档", vbCritical, "打开的Word文档数量过多！"
        Set wdApp = Nothing
        Exit Sub
    End If

    With wdApp
        Set wdDoc = wdApp.ActiveDocument
        wdDoc.Activate
        
        ' 这里仅示例单个书签的处理，300个书签可通过数组循环批量处理
        If wdDoc.Bookmarks.Exists("Section_Rent") = True Then
            BookmarkText = wdDoc.Bookmarks("Section_Rent").Range.Text
            ' 提取书签名对应段落的纯编号
            SectionNum = wdDoc.Bookmarks("Section_Rent").Range.Paragraphs(1).Range.ListFormat.ListString
            xlWs.Cells(202, 22) = "Section_Rent"
            xlWs.Cells(202, 23) = BookmarkText
            ' 可自行调整列号存放段落编号，此处示例放在第24列
            xlWs.Cells(202, 24) = SectionNum
        End If

    End With

    ActiveWorkbook.RefreshAll
    ActiveSheet.PivotTables("Data_Input_Table").PivotFields("Trimmed Data"). _
    PivotFilters.Add2 Type:=xlCaptionIsGreaterThan, Value1:="0"
    

    Columns("D:D").EntireColumn.AutoFit
    Range("A1").Select

    MsgBox "数据传输完成。"

End Sub

批量处理优化建议 #

如果有300个书签需要处理，可以提前把书签名称、对应填写的行号存在数组里，循环遍历数组执行判断和赋值操作，不需要重复写300次相同的判断逻辑，代码可维护性更高。

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