Word宏自动化实现英西语双语段落交替合并（学习用）

一、两种自动化合并模式的宏实现 #

(a) 按段落分隔符交替合并 #

此模式基于英西文档段落一一对应的前提，依次将英文段落、对应西语段落复制到目标文档，实现交替排版。

Sub MergeByParagraph()
    ' 定义文档对象
    Dim docEng As Document, docSpa As Document, docTarget As Document
    Dim paraEng As Paragraph, paraSpa As Paragraph
    
    ' 替换为你的实际文档名称
    Set docEng = Documents("英文书籍.docx")
    Set docSpa = Documents("西语书籍.docx")
    Set docTarget = Documents.Add ' 可替换为已有目标文档路径
    
    ' 遍历段落，交替复制英西内容
    For Each paraEng In docEng.Paragraphs
        If paraEng.Index <= docSpa.Paragraphs.Count Then
            Set paraSpa = docSpa.Paragraphs(paraEng.Index)
            
            ' 粘贴英文段落
            paraEng.Range.Copy
            docTarget.Content.PasteAndFormat wdFormatOriginalFormatting
            docTarget.Content.InsertParagraphAfter
            
            ' 粘贴对应西语段落
            paraSpa.Range.Copy
            docTarget.Content.PasteAndFormat wdFormatOriginalFormatting
            docTarget.Content.InsertParagraphAfter
            docTarget.Content.InsertParagraphAfter ' 空行分隔段落组
        End If
    Next paraEng
    
    ' 保存合并后的文档
    docTarget.SaveAs2 "英西对照书籍.docx"
    MsgBox "合并完成！"
End Sub

(b) 按字符/词数（标点截断）交替合并 #

此模式会以350字符或100词为上限，自动找到最近的标点（.!?）作为分割点，将长文本拆分为片段后交替合并，适合段落过长的场景。

Sub MergeByCharOrWord()
    Dim docEng As Document, docSpa As Document, docTarget As Document
    Dim rngEng As Range, rngSpa As Range
    Dim charCount As Integer, wordCount As Integer
    Dim pos As Integer, lastPos As Integer
    
    ' 替换为你的实际文档名称
    Set docEng = Documents("英文书籍.docx")
    Set docSpa = Documents("西语书籍.docx")
    Set docTarget = Documents.Add
    
    Set rngEng = docEng.Content
    Set rngSpa = docSpa.Content
    
    lastPos = 1
    Do While lastPos < rngEng.End
        ' 重置计数
        charCount = 0
        wordCount = 0
        pos = lastPos
        
        ' 遍历到符合条件的标点位置
        Do While pos < rngEng.End
            charCount = charCount + 1
            If rngEng.Characters(pos).Text = " " Then wordCount = wordCount + 1
            
            ' 触发条件：达到字符/词数上限，且当前字符是标点
            If (charCount >= 350 Or wordCount >= 100) And InStr(".!?", rngEng.Characters(pos).Text) > 0 Then
                Exit Do
            End If
            pos = pos + 1
        Loop
        
        ' 复制粘贴英文片段
        rngEng.SetRange Start:=lastPos, End:=pos
        rngEng.Copy
        docTarget.Content.PasteAndFormat wdFormatOriginalFormatting
        docTarget.Content.InsertParagraphAfter
        
        ' 复制粘贴对应西语片段（若文本长度比例有偏差，可调整pos的计算逻辑）
        rngSpa.SetRange Start:=lastPos, End:=pos
        rngSpa.Copy
        docTarget.Content.PasteAndFormat wdFormatOriginalFormatting
        docTarget.Content.InsertParagraphAfter
        docTarget.Content.InsertParagraphAfter
        
        lastPos = pos + 1
    Loop
    
    docTarget.SaveAs2 "英西对照分段书籍.docx"
    MsgBox "分段合并完成！"
End Sub

二、手动录制宏代码的中文注释翻译 #

你提供的宏是基于特定文档的手动操作记录，以下是带中文注释的完整版本：

Sub Macro1()
    ' 激活"3.doc - Compatibility Mode"文档
    Windows("3.doc  -  Compatibility Mode").Activate
    ' 向下选中13行，再向上调整1行（最终选中12行）
    Selection.MoveDown Unit:=wdLine, Count:=13, Extend:=wdExtend
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    ' 复制选中内容
    Selection.Copy
    ' 切换到目标文档"656398.docx - Compatibility Mode"
    Windows("Document2").Activate
    Windows("656398.docx  -  Compatibility Mode").Activate
    ' 保留原格式粘贴
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    
    ' 调整选中范围：向下选23行→向上调7行→向下调3行
    Selection.MoveDown Unit:=wdLine, Count:=23, Extend:=wdExtend
    Selection.MoveUp Unit:=wdLine, Count:=7, Extend:=wdExtend
    Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
    ' 复制选中内容
    Selection.Copy
    ' 切换回"3.doc"文档并粘贴
    Windows("Document2").Activate
    Windows("3.doc  -  Compatibility Mode").Activate
    Selection.PasteAndFormat (wdPasteDefault)
    
    ' 多次微调选中范围：向下选8行→向上调1行→向下调1行→向左选2字符→向右调1字符
    Selection.MoveDown Unit:=wdLine, Count:=8, Extend:=wdExtend
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    ' 复制选中内容
    Selection.Copy
    ' 切换到"656398.docx"文档粘贴
    Windows("Document2").Activate
    Windows("656398.docx  -  Compatibility Mode").Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    
    ' 向下选中18行并复制
    Selection.MoveDown Unit:=wdLine, Count:=18, Extend:=wdExtend
    Selection.Copy
    ' 切换到"Document2"文档，换行后按目标样式粘贴
    Windows("Document2").Activate
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.PasteAndFormat (wdUseDestinationStylesRecovery)
    ' 保存当前文档
    ActiveDocument.Save
End Sub

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