将整个工作表内容复制到已打开的Word文档中

时间:2012-09-28 17:22:47

标签: excel vba ms-word worksheet office-2007

我有两个部分工作的代码组合在一起。

我有一个标记为'word'的工作表,我想将其导出并自动保存在变量下。

Sub CreateNewWordDoc()

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim i As Integer
docname = Worksheets("input").Range("b10").Value

Data1 = Worksheets("word").Range("a1:d103").Value
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Results\ResultsTemplate.doc")


'******THIS IS TO EDIT THE WORD DOCUMENT******
With Worksheets("word")
    CopyRangeToWord wdDoc, .Range("A1:d104")



'******THIS IS THE END TO EDIT THE WORD DOCUMENT*****


    If Dir("C:\Results\" & docname & ".doc") <> "" Then
        Kill "C:\Results\" & docname & ".doc"
    End If
    .SaveAs ("C:\Results\" & docname & ".doc")
    .Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub

我最喜欢这个第一个。它将打开我的模板,其中包含这些生成的报告将需要的所有官方内容(公司信息等),并将使用正确的文件名自动保存和关闭。但是,我找不到办法让它将工作表“word”中的所有信息复制到文档的文本正文中。它正在保存一个空白文件。

在排除故障时,我遇到了这段代码:

Private Sub CopyRangeToWord(ByRef wdDoc As Word.Document, rng_to_copy As Range, Optional page_break As Boolean = True)
' Will copy the range given into the word document given.
Application.StatusBar = "Copying data from " & rng_to_copy.Parent.Name & "..."
rng_to_copy.Copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
Application.CutCopyMode = False
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
' insert page break after all worksheets except the last one
If page_break Then
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
        .InsertParagraphBefore
        .Collapse Direction:=wdCollapseEnd
        .InsertBreak Type:=wdPageBreak
    End With
End If

End Sub


Sub CopyWorksheetsToWord()

    Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet
    Application.ScreenUpdating = False
    Application.StatusBar = "Creating new document..."
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Add
    docname = Worksheets("input").Range("b10").Value

    With Worksheets("word")
        CopyRangeToWord wdDoc, .Range("A1:d104")

    End With

    Set ws = Nothing
    Application.StatusBar = "Cleaning up..."
     'apply normal view
    With wdApp.ActiveWindow
        If .View.SplitSpecial = wdPaneNone Then
            .ActivePane.View.Type = wdNormalView
        Else
            .View.Type = wdNormalView
        End If
    End With

    Set wdDoc = Nothing
    wdApp.Visible = True
    Set wdApp = Nothing
    Application.StatusBar = False

End Sub

与第一个代码完全相反:它将打开一个新文档(而不是模板),将完美地复制所有数据,但不会保存或关闭正确的文件名。

我猜测更新代码第一部分以复制工作表内容会更容易,这也是我更喜欢的。

1 个答案:

答案 0 :(得分:1)

Private Sub CopyRangeToWord(ByRef wdDoc As Word.Document, rng_to_copy As Range, Optional page_break As Boolean = True)
' Will copy the range given into the word document given.
    Application.StatusBar = "Copying data from " & rng_to_copy.Parent.Name & "..."
    rng_to_copy.Copy
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
    Application.CutCopyMode = False
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    ' insert page break after all worksheets except the last one
    If page_break Then
        With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
            .InsertParagraphBefore
            .Collapse Direction:=wdCollapseEnd
            .InsertBreak Type:=wdPageBreak
        End With
    End If


End Sub

Sub CopyWorksheetsToWord()

Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet
    Application.ScreenUpdating = False
    Application.StatusBar = "Creating new document..."
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Add
    docname = Worksheets("input").Range("b10").Value


    With Worksheets("word")
        CopyRangeToWord wdDoc, .Range("A1:d104")

    With wdDoc
    .SaveAs ("C:\Results\" & docname & ".doc")
    .Close
    End With

    End With

End Sub

这有效:但不会从我的模板打开。尽管如此 - 它将从一个工作表创建一个文档,并自动将其保存到目录中,并在定义的单元格中引用文件名。