在日常办公中，我们经常需要把一份长篇幅 Word 文档的大纲提取出来，不管是用来做汇报汇报、写总结，还是梳理思维导图。如果手动去复制粘贴，不仅费时费力，还容易漏掉层级。

今天给大家分享一段我常用的 VBA 宏代码。与其他提取大纲的方法相比，这段代码最大的特点是**“返璞归真、极其稳定”。它不会因为 Word 版本不同或样式冲突而报错（避免了提取出来是空文档的尴尬），而是直接将大纲提取为纯文本**，并贴心地为你自动加上缩进和“1.1.1”这样的层级编号。

✨ 效果预览

假设你设置提取到 3 级标题，运行代码后，Word 会自动弹出一个新文档，内容呈现如下格式：

1. 一级标题
    1.1. 二级标题
        1.1.1. 三级标题
        1.1.2. 另一个三级标题
    1.2. 另一个二级标题
2. 第二个一级标题

🚀 完整 VBA 代码

请将以下代码复制备用：

Sub ExtractHeadingsWithTextNumbering()
    Dim docSource As Document
    Dim docTarget As Document
    Dim para As Paragraph
    Dim MaxHeadingLevel As Integer
    Dim currentLevel As Integer
    Dim extractText As String
    
    ' 用于记录各级标题编号的数组 (支持1到9级)
    Dim headingCounters(1 To 9) As Integer
    Dim i As Integer
    Dim numberPrefix As String
    Dim indentSpaces As String
    
    ' ==========================================
    ' 【自定义设置区】
    ' 设置你要提取到的最低标题级别 (1-9)
    MaxHeadingLevel = 3 
    ' ==========================================
    
    Set docSource = ActiveDocument
    Set docTarget = Documents.Add 
    
    ' 关闭屏幕更新提速
    Application.ScreenUpdating = False 
    
    For Each para In docSource.Paragraphs
        ' 采用最可靠的识别方式：仅识别标准大纲级别
        If para.OutlineLevel >= wdOutlineLevel1 And para.OutlineLevel <= wdOutlineLevel9 Then
            currentLevel = para.OutlineLevel
            
            If currentLevel <= MaxHeadingLevel Then
                ' 提取纯文本并清理换行符
                extractText = Replace(para.Range.Text, vbCr, "")
                extractText = Replace(extractText, Chr(11), "")
                extractText = Replace(extractText, Chr(7), "")
                
                If Len(Trim(extractText)) > 0 Then
                    
                    ' --- 开始计算分级编号 ---
                    ' 1. 当前级别的计数器 +1
                    headingCounters(currentLevel) = headingCounters(currentLevel) + 1
                    
                    ' 2. 将比当前级别更低的子级别计数器全部清零
                    For i = currentLevel + 1 To 9
                        headingCounters(i) = 0
                    Next i
                    
                    ' 3. 拼接完整的编号前缀 (例如 "1.2.1.")
                    numberPrefix = ""
                    For i = 1 To currentLevel
                        If headingCounters(i) = 0 Then headingCounters(i) = 1
                        numberPrefix = numberPrefix & headingCounters(i) & "."
                    Next i
                    ' ------------------------
                    
                    ' 结合空格缩进逻辑，让排版更美观
                    If currentLevel > 1 Then
                        indentSpaces = String((currentLevel - 1) * 4, " ")
                    Else
                        indentSpaces = ""
                    End If
                    
                    ' 用最原始稳定的 InsertAfter 方法将 缩进、编号、文字和回车 一起写入
                    docTarget.Content.InsertAfter indentSpaces & numberPrefix & " " & extractText & vbCr
                    
                End If
            End If
        End If
    Next para
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True 
    MsgBox "提取完成！已为您提取纯文本大纲，并成功添加了分点编号。", vbInformation, "提取成功"
End Sub

📖 傻瓜式使用指南（只需 4 步）

如果你是第一次使用 Word 宏，不用担心，跟着下面的步骤走，1 分钟搞定：

1. 打开宏编辑器打开你需要提取大纲的 Word 文档，按下键盘上的 Alt + F11 组合键，这会打开一个叫“VBA 编辑器”的窗口。
2. 插入新模块在弹出的窗口左上角，找到你的文档名字（或者 Normal），右键点击它，选择 插入 (Insert) -> 模块 (Module)。
3. 粘贴代码并设置级别把上面提供的代码完整粘贴到右侧的大空白输入框里。👉 注意这里： 找到代码中的 MaxHeadingLevel = 3 这一行。默认是提取到 3 级标题。如果你只想提取 1 级和 2 级标题，把它改成 MaxHeadingLevel = 2 即可。
4. 一键运行按下键盘上的 F5 键（或者点击上方工具栏里的绿色播放小三角 ▶）。

大功告成！ 等待几秒钟（取决于你的文档有多长），Word 就会自动为你新建一个文档，里面就是排版整齐、自带编号的纯文本大纲了。

💡 小贴士：

提取出来的大纲是纯文本格式，非常干净。你可以直接把它复制到 Notion、Typora 等支持 Markdown 的笔记软件里，或者直接发给同事，再也不用担心带着一堆乱七八糟的 Word 隐藏格式了！