如何用VBA宏去除Word段落末的widow word并添加non breaking space？

原宏存在两个核心问题：

• 无差别合并所有段落的最后两个词，未精准识别仅段落最后一行单独一个词的widow场景
• 使用For Each遍历段落时，修改文本会触发Word重新计算段落结构，导致循环卡顿甚至死循环

以下是优化后的宏代码，仅针对真正的widow word处理，且能稳定遍历整个文档：

Private Sub FixWidowWords()
    Dim doc As Document
    Dim para As Paragraph
    Dim paraRange As Range
    Dim lastWordRange As Range
    Dim prevWordRange As Range
    Dim lineCount As Integer
    
    Set doc = ActiveDocument
    
    ' 从后往前遍历段落，避免修改段落引发的集合结构变化问题
    For i = doc.Paragraphs.Count To 1 Step -1
        Set para = doc.Paragraphs(i)
        Set paraRange = para.Range
        
        ' 跳过空段落或仅含换行的段落
        If Len(Trim(paraRange.Text)) > 1 Then
            ' 计算段落总行数
            lineCount = paraRange.Information(wdLastCharacterLineNumber) - _
                        paraRange.Information(wdFirstCharacterLineNumber) + 1
            
            ' 仅处理多行段落（单行段落不存在widow）
            If lineCount > 1 Then
                ' 定位段落最后一个词，排除段落结束标记(Chr(13))
                Set lastWordRange = paraRange.Words(paraRange.Words.Count)
                If lastWordRange.Text = Chr(13) Then
                    Set lastWordRange = paraRange.Words(paraRange.Words.Count - 1)
                End If
                
                ' 判断最后一个词是否单独在最后一行
                If lastWordRange.Information(wdFirstCharacterLineNumber) = _
                   paraRange.Information(wdLastCharacterLineNumber) Then
                    ' 获取前一个词的范围
                    Set prevWordRange = lastWordRange.Previous(wdWord, 1)
                    If Not prevWordRange Is Nothing Then
                        ' 前一个词在上一行，确认是widow word
                        If prevWordRange.Information(wdFirstCharacterLineNumber) < _
                           lastWordRange.Information(wdFirstCharacterLineNumber) Then
                            ' 将前一个词后的普通空格替换为非断空格(ChrW(160))
                            prevWordRange.Collapse wdCollapseEnd
                            prevWordRange.MoveEnd wdCharacter, 1
                            prevWordRange.Text = ChrW(160)
                        End If
                    End If
                End If
            End If
        End If
    Next i
End Sub

关键优化说明 #

• 反向遍历段落：从最后一段往前处理，避免修改段落时打乱Paragraphs集合的遍历顺序，彻底解决循环卡顿问题
• 精准识别widow：通过Word的Information属性判断最后一个词是否单独占据段落最后一行，仅处理符合条件的场景
• 直接操作Range对象：避免拆分/拼接文本破坏原文档格式（如特殊空格、格式标记等），操作更精准
• 处理段落结束标记：自动排除段落末尾的换行符干扰，确保定位到真正的内容词

内容的提问来源于stack exchange，提问作者Balasubramaniyan-mac