将多个工作表粘贴到单个Word文档中

时间:2015-05-29 19:24:24

标签: excel vba excel-vba

我正在尝试将工作簿中的每个工作表复制并粘贴到单个Word文档中的新工作表中。不幸的是,它只是复制第一个工作表的内容,尽管它似乎正在循环遍历所有工作表。我认为插入分页符会有效,但事实并非如此。它也不会让我在Word中格式化它。我希望A1的内容具有标题样式。

这是我的代码:

Sub ExceltoWord()
Dim ws As Worksheet
Dim Wkbk1 As Workbook
Set Wkbk1 = ActiveWorkbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

For Each ws In Wkbk1.Worksheets
Wkbk1.ActiveSheet.Range("A1:A2").Copy
Dim wdapp As Object
Dim wddoc As Object
Dim Header As Range
'file name & folder path
Dim strdocname As String
  On Error Resume Next
'error number 429
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
    Err.Clear
'create new instance of word application
    Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
'define paths to file
strdocname = "P:\ImportedDescriptions.doc"
If Dir(strdocname) = "" Then
    MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "P:\ImportedDescriptions.doc", vbExclamation, "The document does not exist "
    Exit Sub
End If

wdapp.Activate
Set wddoc = wdapp.Documents(strdocname)
If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(strdocname)

Set Header = Range("A1")
'must activate to be able to paste
wddoc.Activate
wddoc.Range.Paste
Selection.WholeStory
Header.Style = ActiveDocument.Styles("Heading 2")
Selection.InsertBreak Type:=wdPageBreak
Next ws
wddoc.Save
'wdapp.Quit

Set wddoc = Nothing
Set wdapp = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

2 个答案:

答案 0 :(得分:2)

您只是从活动工作表中复制,这恰好是您案例中的第一张工作表。而不是:

case 2:
    temp = first;
    while (temp != NULL)
    {
        temp->output(temp);
        temp = temp->next;
    }
    break;
case 3:  // for write in file
    fstream file;
    file.open("group.dat", ios::app | ios::out | ios::in | ios::binary);
    {
        temp = first;
        while (temp != NULL)
        {

            file.write(reinterpret_cast<char*>(&temp), sizeof(user));

            temp = temp->next;
        }
    }

    exit(-1);
case 4:  // for Read from file
    fstream file;
    file.open("group.dat", ios::app | ios::out | ios::in | ios::binary);
    file.seekg(0);

    while (!file.eof())
    {
        file.read(reinterpret_cast<char*>(&temp), sizeof(user));

    }

使用:

For Each ws In ActiveWorkbook.Worksheets
ActiveWorkbook.ActiveSheet.Range("A1:A2").Copy

这将依次复制每个范围。

答案 1 :(得分:0)

我认为当你激活Word时,它正在失去你开始使用的工作簿。将工作簿保存到Workbook变量(即Dim Wkbk1 As WorkbookSet Wkbk1 = ActiveWorkbook),然后用Wkbk1替换代码中的每个ActiveWorkbook实例(在For Each循环中,每次要在其中引用它)循环也是如此)。