如何用VBA移除Word段落末尾换行并合并段落？问题排查与解决

需求说明 #

需要将Word中如下格式的文本：

My name
is
John Doe.

合并为单行：My name is John Doe.

第一段代码的错误排查 #

编写的VBA代码出现编译错误：Can't find project or library，代码如下：

Sub removelinebreak()
    Dim rng As Range
    Dim para As paragraph
    
    Set rng = Selection.Range
    
    ' Loop through each paragraph in the range
    For Each para In rng.Paragraphs
        Debug.Print para.Range.text
        If Right(para.Range.text, 1) = vbCr Or Right(para.Range.text, 1) = vbLf Then
            para.Range.Collapse Direction:=wdCollapseEnd
            para.Range.MoveStart Unit: wdCharacter , Count:=-1
            para.Range.Delete
        End If
    Next para
End Sub

错误原因：

1. paragraph首字母未大写，Word对象模型中应为Paragraph
2. MoveStart方法参数语法错误，Unit:后缺少等号，正确写法是Unit:=wdCharacter
3. 未引用Word对象库时，需用VBA.Right替代Right，避免与其他库的同名函数冲突

数组方法的问题分析 #

尝试用数组方法实现，但仅在文本前添加空格，未移除换行符，输出结果：

My name
 is
 John Doe.

代码如下：

Sub AddSelectedParagraphsToArray()
    Dim selectedParagraphs() As String ' Declare an array to store the selected paragraphs
    Dim paragraph As paragraph ' Variable to hold each selected paragraph
    Dim i As Long
      
    ' Resize the array to accommodate the selected paragraphs
    ReDim selectedParagraphs(1 To Selection.Range.Paragraphs.Count)
    
    ' Loop through the selected paragraphs and add them to the array
    For i = 1 To Selection.Range.Paragraphs.Count
        Set paragraph = Selection.Range.Paragraphs(i)
        paragraph.Range.Collapse Direction:=wdCollapseEnd 'Collapse the range to the last point of the paragraph
        paragraph.Range.MoveEnd Unit:=wdCharacter, Count:=-1 ' Select the line break
        'selectedParagraphs(i) = Replace(paragraph.Range.text, vbCrLf, " ")
        selectedParagraphs(i) = paragraph.Range.text
    Next
    
    ' Join the elements of the array back into a single string
    Dim joinedText As String
    joinedText = Join(selectedParagraphs, " ")
    
    ' Display the joined text in a message box
    'MsgBox joinedText
    Selection.Range.text = joinedText
End Sub

问题原因：代码尝试选中换行符，但未正确捕获排除换行符的段落文本，导致数组中仍包含换行符，Join后换行符未被替换。

可行解决方案 #

方案1：使用Left函数截取文本 #

通过Left函数移除段落末尾的换行符，再用空格拼接：

Sub AddSelectedParagraphsToArray()
    Dim selectedParagraphs() As String ' 存储选中段落的数组
    Dim paragraph As Paragraph ' 单个段落对象
    Dim i As Long
      
    ' 根据选中段落数量调整数组大小
    ReDim selectedParagraphs(1 To Selection.Range.Paragraphs.Count)
    
    ' 遍历选中段落，移除末尾换行符后存入数组
    For i = 1 To Selection.Range.Paragraphs.Count
        Set paragraph = Selection.Range.Paragraphs(i)
        selectedParagraphs(i) = VBA.Left(paragraph.Range.text, VBA.Len(paragraph.Range.text) - 1)
    Next
    
    ' 将数组合并为单行文本
    Dim joinedText As String
    joinedText = Join(selectedParagraphs, " ")
    
    ' 替换选中区域的文本
    Selection.Range.text = joinedText
End Sub

方案2：使用Replace函数替换换行符 #

先将段落文本存入数组，合并后直接替换所有换行符为空格：

Sub ReplaceSelectedRangeWithJoinedText()
    Dim selectedParagraphs() As String ' 存储选中段落的数组
    Dim paragraph As Paragraph ' 单个段落对象
    Dim i As Long
    
    ' 根据选中段落数量调整数组大小
    ReDim selectedParagraphs(1 To Selection.Range.Paragraphs.Count)

    ' 遍历选中段落，存入数组
    For i = 1 To Selection.Range.Paragraphs.Count
        Set paragraph = Selection.Range.Paragraphs(i)
        selectedParagraphs(i) = paragraph.Range.text
    Next
    
    ' 合并数组并替换换行符为空格
    Dim joinedText As String
    Dim texttoreplace As String
    joinedText = Join(selectedParagraphs, "")
    texttoreplace = Replace(joinedText, vbCr, " ")
    
    ' 替换选中区域的文本
    Selection.Range.text = texttoreplace
End Sub

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