分享一段Word批量合并的代码

约定的童话

Sub 开始合并()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim i, n, arr, f, ff, fso, Myword As Object, Word As Object
    Set Word = VBA.CreateObject("word.application")
    Word.Visible = 0
    Word.Documents.Add DocumentType:=wdNewBlankDocument '新建word
    Word.ActiveDocument.SaveAs [g1] & "\" & [e1] & ".doc" '存放指定位置并命名好
    arr = [a1].CurrentRegion
    lj = [g1]
    For i = 2 To UBound(arr)
        If arr(i, 2) <> "" Then
            n = n + 1 '份数
            s = n & "."
            Word.Documents.Open (lj & "\" & arr(i, 1)) '打开模板word数据
            Word.ActiveDocument.Bookmarks("\page").Range.Copy '选择数据复制粘贴
            Word.ActiveDocument.Close False '关闭当前这个word文件
'            Word.ActiveDocument.Range.InsertBefore (s)
            Word.Selection.PasteAndFormat (wdUseDestinationStylesRecovery) '粘贴在下面
        End If
    Next
    Word.ActiveDocument.Close True
    Word.Application.Quit
    Set Word = Nothing
    MsgBox "合并完成！", 64, "提示！"
End Sub

lizhipei78

Sub MergeDocuments()
    Application.ScreenUpdating = False
    MyPath = ActiveDocument.Path
    MyName = Dir(MyPath & "\" & "*.*")
    pagenum = 1
Do While MyName <> ""
    If MyName <> ActiveDocument.Name Then
        Set wb = Documents.Open(MyPath & "\" & MyName)
        Selection.WholeStory
        Selection.Copy
        Windows(1).Activate
        Selection.Paste
        wb.Close False
        Selection.EndKey Unit:=wdLine
        Selection.InsertBreak Type:=wdPageBreak
        Selection.InsertBreak Type:=wdSectionBreakContinuous
        pagenum = Word.ActiveDocument.Range.Information(wdNumberOfPagesInDocument)
        Selection.GoTo wdGoToPage, , pagenum
    End If
    MyName = Dir
    DoEvents
Loop
Application.ScreenUpdating = True
End Sub

rrxfw

牛，大神就是大神

cai2532

厉害，收藏学习了。

游乐缘

感谢分享，留名学习