如何实现批量复制文档(含表格)到一个新文档中

huangyun

各位朋友、版主，请帮帮我吧。

huangyun

怎么了，没附件的时候有答复的，传了附件没人理会了。

守柔

QUOTE:

以下是引用huangyun在2006-12-9 11:11:01的发言：

我有二个问题请教各位朋友:

一、我有几十个结构一样的WORD表格，它们只有一页大小，带抬头的。现在想要一一复制粘贴到一个新文档（空白）中，EXCEL VBA我能写代码实现，WORD VBA没有具体接触，所以不会写。具体要求如下：运行宏后，首先出现一个允许选择多个文档的打开对话框，然后使用CTRL/SHIFT键，我进行多选后，宏能够将所选文档内容（含抬头、表格、内容）都复制到VBA代码所在文档中，最后报出所复制的文件名。

二、上面的文档制作好后，需要进行标题设置，也就是将抬头都设置成标题1样式或某种样式，这样以便我接下去制作目录。具体要求如下：运行宏后，首先出现一个INPUTBOX对话框，提示输入有具有共同标志的文字部分（也就是说，这几十个文档的抬头都是“**公司达标申报表”，我只需要输入“公司达标申报表”），这样宏自动查找文字部分所在行，并将其设置成标题1样式。

谢谢各位。

第一种思路：

我觉得使用WORD自带的功能，基本能够实现楼主的需要：

插入/文件。

使用查找与替换功能，将关键字所在的段落设置为标题样式。

只是文件名无法取得。

第二种思路：

VBA法，由于你说的文档基于一页，而你又需要将该页的内容复制到新文档中，还是利用插入/文件功能,插入文件名，完成所有文档插入后，进行查找与替换。

第三种思路：

使用对话框，使用复制与粘贴，其它思路同上。

范例如下：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋

'* Created By SHOUROU@ExcelHome 2006-12-15 6:26:31

'仅测试于System: Windows NT Word: 11.0 Language: 2052

'№ 0116^The Code CopyIn [ThisDocument-ThisDocument]^'

'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit

Sub Example2()    '此代码功能为列出指定文件夹中所有选取的WORD文件全路径名

    Dim MyDialog As FileDialog, vrtSelectedItem As Variant

    Dim myRange As Range, KeyFind As String

    On Error Resume Next    '忽略错误

    '定义一个文件夹选取对话框

    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)

    With MyDialog

        .Filters.Clear    '清除所有文件筛选器中的项目

        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件

        .AllowMultiSelect = True    '允许多项选择

        If .Show = -1 Then    '确定

            For Each vrtSelectedItem In .SelectedItems    '在所有选取项目中循环

                With ThisDocument

                    Set myRange = .Range(.Content.End - 1, .Content.End - 1)

                    myRange.InsertAfter vrtSelectedItem & Chr(13)

                    Set myRange = .Range(.Content.End - 1, .Content.End - 1)

                    myRange.InsertFile FileName:=vrtSelectedItem, Range:="", link:=False

                End With

            Next

        End If

    End With

    KeyFind = VBA.InputBox(prompt:="请输入需要设置标题样式的关键字!", Title:="Excelhome", Default:="公司达标申报表")

    If KeyFind = "" Then Exit Sub

    With ThisDocument.Content.Find

        .ClearFormatting

        .Text = KeyFind

        .Format = True

        .Replacement.ClearFormatting

        .Replacement.Text = ""

        .Replacement.Style = "标题 1"

        If .Execute(Replace:=wdReplaceAll) = False Then

            MsgBox "Word没有找到指定的内容,请检查!"

        Else

            MsgBox "Word已进行指定内容的样式设置!"

        End If

    End With

End Sub

'----------------------

[此贴子已经被作者于2006-12-15 6:26:51编辑过]

huangyun

谢谢版主帮助，但程序执行到这句Dim MyDialog As FileDialog就提示用户定义类型未定义，执行不下去了，是需要引用什么吗，还是有其它要求。

守柔

QUOTE:

以下是引用huangyun在2006-12-15 7:40:58的发言：
谢谢版主帮助，但程序执行到这句Dim MyDialog As FileDialog就提示用户定义类型未定义，执行不下去了，是需要引用什么吗，还是有其它要求。

FileDialog对象需要WORD XP及其以上版本，看来你是WORD2000了。如果是WORD2000，建议升级一下，若是使用WINDOWS的通用对话框，可能也会有所局限，有关“通用对话框”的操作，可以以此搜索本版。