需求：为Word文档Heading1下方段落批量统计并显示字数

以下是实现需求的VBA宏代码，能自动遍历文档中所有Heading1样式的段落，统计该Heading1到下一个Heading1之间（或文档结尾）的内容字数，并将字数添加到Heading1标题后：

Sub AddWordCountToHeading1()
    Dim doc As Document
    Dim currentHeading As Paragraph
    Dim nextHeading As Paragraph
    Dim rangeToCount As Range
    Dim wordCount As Long
    
    Set doc = ActiveDocument
    
    ' 遍历所有Heading1段落
    For Each currentHeading In doc.Paragraphs
        If currentHeading.Style = doc.Styles("Heading 1") Then
            ' 查找下一个Heading1段落
            Set nextHeading = currentHeading.Next
            Do While Not nextHeading Is Nothing
                If nextHeading.Style = doc.Styles("Heading 1") Then
                    Exit Do
                End If
                Set nextHeading = nextHeading.Next
            Loop
            
            ' 确定统计范围：当前Heading1之后到下一个Heading1之前（不含下一个Heading1）
            If nextHeading Is Nothing Then
                Set rangeToCount = doc.Range(currentHeading.Range.End, doc.Content.End)
            Else
                Set rangeToCount = doc.Range(currentHeading.Range.End, nextHeading.Range.Start)
            End If
            
            ' 统计字数（默认按单词统计，适合英文文档）
            wordCount = rangeToCount.Words.Count
            ' 若为中文文档，建议改用纯字符统计（排除空格），取消下面一行注释即可
            ' wordCount = rangeToCount.Characters.Count - Len(Replace(rangeToCount.Text, " ", ""))
            
            ' 修改Heading1文本，追加字数统计
            currentHeading.Range.Text = Left(currentHeading.Range.Text, Len(currentHeading.Range.Text) - 1) & " (" & wordCount & ")" & vbCr
        End If
    Next currentHeading
    
    MsgBox "字数统计已添加完成！", vbInformation
End Sub

代码说明 #

• 核心逻辑：逐个定位Heading1段落，通过循环找到下一个Heading1，划定两者之间的内容范围进行字数统计
• 字数统计适配：默认用Words.Count统计单词数；中文文档可切换到字符统计（已给出注释示例）
• 格式处理：将字数以(字数)形式追加到原Heading1标题末尾

使用步骤 #

• 打开目标Word文档，先备份原文档（避免操作失误导致内容丢失）
• 按下Alt + F11打开VBA编辑器
• 在左侧“项目”窗口中，右键点击当前文档，选择「插入」→「模块」
• 将上述代码粘贴到模块窗口中
• 按下F5运行宏，或点击编辑器工具栏的运行按钮
• 完成后会弹出提示框，关闭编辑器回到文档即可查看效果

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