以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  如何将多个WORD文件合并在一个WORD文件上,保持原格式不变?  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=79113)

--  作者:发财
--  发布时间:2015/12/24 15:11:00
--  如何将多个WORD文件合并在一个WORD文件上,保持原格式不变?
如何用代码将多个WORD文件合并在一个WORD文件上,保持原格式不变?
--  作者:大红袍
--  发布时间:2015/12/24 15:17:00
--  

拷贝,粘贴不就行了?如代码

 

 

Dim wapp1 As New MSWord.Application
Dim wapp2 As New MSWord.Application
try
    Dim doc1 = wapp1.Documents.Open("d:\\test1.doc")
    Dim doc2 = wapp2.Documents.Open("d:\\test2.doc")
    wapp2.ActiveWindow.Selection.WholeStory
    wapp2.ActiveWindow.Selection.copy
   
    wapp1.ActiveWindow.Selection.WholeStory
    wapp1.ActiveWindow.Selection.MoveRight(Unit:=1, Count:=1)
    wapp1.ActiveWindow.Selection.TypeParagraph
    wapp1.ActiveWindow.Selection.paste
    wapp2.Quit
    wapp1.Visible = True
catch ex As exception
    msgbox(ex.message)
    wapp1.Quit
    wapp2.Quit
finally
   
end try

--  作者:发财
--  发布时间:2015/12/24 15:36:00
--  

Dim wapp1 As New MSWord.Application
Dim wapp2 As New MSWord.Application
For Each file As String In filesys .GetFiles(ProjectPath & "文件夹")
    If file.EndsWith(".doc") Then
        try
            Dim doc1 = wapp1.Documents.Open("E:\\合并表.doc")
            Dim doc2 = wapp2.Documents.Open(file)
            wapp2.ActiveWindow.Selection.WholeStory
            wapp2.ActiveWindow.Selection.copy
            wapp1.ActiveWindow.Selection.WholeStory
            wapp1.ActiveWindow.Selection.MoveRight(Unit:=1, Count:=1)
            wapp1.ActiveWindow.Selection.TypeParagraph
            wapp1.ActiveWindow.Selection.paste
            wapp2.Quit
            wapp1.Visible = True
        catch ex As exception
            msgbox(ex.message)
            wapp1.Quit
            wapp2.Quit
        finally
        End try
    End If
Next

如果文件夹中有多个WORD文件,应如何改?


--  作者:大红袍
--  发布时间:2015/12/24 15:41:00
--  

Dim wapp1 As New MSWord.Application
Dim wapp2 As New MSWord.Application
try
    Dim doc1 = wapp1.Documents.Open("E:\\合并表.doc")
    For Each file As String In filesys .GetFiles(ProjectPath & "文件夹")
        If file.EndsWith(".doc") Then
            Dim doc2 = wapp2.Documents.Open(file)
            wapp2.ActiveWindow.Selection.WholeStory
            wapp2.ActiveWindow.Selection.copy
            wapp1.ActiveWindow.Selection.WholeStory
            wapp1.ActiveWindow.Selection.MoveRight(Unit:=1, Count:=1)
            wapp1.ActiveWindow.Selection.TypeParagraph
            wapp1.ActiveWindow.Selection.paste
           
        End If
    Next
    wapp2.Quit
    wapp1.Visible = True
catch ex As exception
    msgbox(ex.message)
    wapp1.Quit
    wapp2.Quit
finally
End try


--  作者:发财
--  发布时间:2015/12/24 15:52:00
--  
表1内容1.5页,表2内容1.6页,合并到合并表中表1占两页,表2占两页,共占4页,而不是3.1页?应如何改?
--  作者:大红袍
--  发布时间:2015/12/24 15:54:00
--  
做不了。
--  作者:发财
--  发布时间:2015/12/24 15:58:00
--  
用换页或添加空行不行吗?
--  作者:大红袍
--  发布时间:2015/12/24 16:03:00
--  

参考代码,改成自己的。

 

Dim wapp1 As New MSWord.Application
Dim wapp2 As New MSWord.Application
try
    Dim doc1 = wapp1.Documents.Open("d:\\test1.doc")
    Dim doc2 = wapp2.Documents.Open("d:\\test2.doc")
    wapp2.ActiveWindow.Selection.WholeStory
    wapp2.ActiveWindow.Selection.copy
   
    wapp1.ActiveWindow.Selection.WholeStory
    wapp1.ActiveWindow.Selection.MoveRight(Unit:=1, Count:=1)
   
    Dim pBreak = MSWord.WdBreakType.wdSectionBreakNextPage
    wapp1.ActiveWindow.Selection.InsertBreak(pBreak)

    wapp1.ActiveWindow.Selection.paste
    wapp2.Quit
    wapp1.Visible = True
catch ex As exception
    msgbox(ex.message)
    wapp1.Quit
    wapp2.Quit
finally
   
End try


--  作者:发财
--  发布时间:2015/12/24 16:46:00
--  
第一页为空白页,应如何清除不要?
--  作者:发财
--  发布时间:2015/12/24 16:50:00
--  
WORD如何加页脚?