Word VBA合并含表格多语言文档报错5251，求解决方法

原代码在处理包含表格的Word文档时，因表格行末尾的段落标记属于表格结构的特殊元素，直接插入内容会触发Run-time error '5251'。以下是修改后的代码，可正确处理表格，实现双语段落交替排列：

Sub MergeBilingualDocsWithTables()
    Application.ScreenUpdating = False
    Dim DocA As Document, DocB As Document, DocCombined As Document
    Dim rngA As Range, rngB As Range, cellA As Cell, cellB As Cell
    Dim i As Long, j As Long
    
    ' 选择源语言文档
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "选择源语言文档"
        .InitialFileName = "C:\Users\" & Environ("Username") & "\Documents\"
        .AllowMultiSelect = False
        If .Show <> -1 Then
            MsgBox "未选择源语言文档，程序退出。", vbExclamation
            Exit Sub
        End If
        Set DocA = Documents.Open(.SelectedItems(1), ReadOnly:=True, AddToRecentFiles:=False)
    End With
    
    ' 选择目标语言文档
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "选择目标语言文档"
        .InitialFileName = DocA.Path & "\"
        .AllowMultiSelect = False
        If .Show <> -1 Then
            MsgBox "未选择目标语言文档，程序退出。", vbExclamation
            DocA.Close SaveChanges:=False
            Set DocA = Nothing
            Exit Sub
        End If
        Set DocB = Documents.Open(.SelectedItems(1), ReadOnly:=True, AddToRecentFiles:=False)
    End With
    
    ' 创建新的合并文档
    Set DocCombined = Documents.Add
    
    ' 处理表格内容
    If DocA.Tables.Count = DocB.Tables.Count Then
        For i = 1 To DocA.Tables.Count
            ' 复制目标语言表格到合并文档
            DocB.Tables(i).Range.Copy
            DocCombined.Content.Paste
            Set cellB = DocCombined.Tables(i).Cell(1, 1) ' 定位到表格第一个单元格
            
            ' 遍历源语言表格的每个单元格，插入到对应目标语言单元格开头
            For Each cellA In DocA.Tables(i).Range.Cells
                j = j + 1
                Set cellB = DocCombined.Tables(i).Cell(cellA.RowIndex, cellA.ColumnIndex)
                cellB.Range.Collapse wdCollapseStart
                cellB.Range.FormattedText = cellA.Range.FormattedText & vbCrLf & cellB.Range.FormattedText
            Next cellA
            j = 0
        Next i
    End If
    
    ' 处理普通段落（非表格内）
    Dim paraA As Paragraph, paraB As Paragraph
    Dim paraCountA As Long, paraCountB As Long
    paraCountA = DocA.Paragraphs.Count
    paraCountB = DocB.Paragraphs.Count
    Dim minParaCount As Long
    minParaCount = IIf(paraCountA < paraCountB, paraCountA, paraCountB)
    
    For i = 1 To minParaCount
        Set paraA = DocA.Paragraphs(i)
        Set paraB = DocB.Paragraphs(i)
        
        ' 跳过表格内的段落（已单独处理）
        If Not paraA.Range.Information(wdWithInTable) And Not paraB.Range.Information(wdWithInTable) Then
            ' 将源语言段落插入到合并文档
            paraA.Range.Copy
            DocCombined.Content.Paste
            ' 将目标语言段落插入到合并文档
            paraB.Range.Copy
            DocCombined.Content.Paste
        End If
    Next i
    
    ' 保存合并文档
    Dim savePath As String
    savePath = Split(DocA.FullName, ".doc")(0) & "-Combined.docx"
    DocCombined.SaveAs2 FileName:=savePath, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    
    ' 关闭文档并释放对象
    DocA.Close SaveChanges:=False
    DocB.Close SaveChanges:=False
    DocCombined.Close SaveChanges:=False
    Set DocA = Nothing: Set DocB = Nothing: Set DocCombined = Nothing
    Application.ScreenUpdating = True
    MsgBox "合并完成，文档已保存至：" & savePath, vbInformation
End Sub

关键修改说明 #

• 单独处理表格内容：匹配两个文档的表格数量，逐个复制目标语言表格到新文档，再将对应源语言表格的单元格内容插入到目标单元格开头，保证表格内的双语内容对应排列
• 跳过表格内段落：遍历普通段落时，通过Information(wdWithInTable)判断段落是否属于表格，避免重复处理表格内的段落
• 创建新文档合并：不再直接修改原文档，而是生成全新的合并文档，避免破坏原文件
• 兼容段落数量差异：取两个文档段落数的最小值进行处理，避免因段落数不一致导致错误

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