0

我有两个部分工作的代码要放在一起。

我有一个标有“单词”的工作表，我想将其导出并自动保存在变量下。

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

我最喜欢这个第一个。它将打开我的模板，其中包含这些生成的报告所需的所有官方资料（公司信息等），并将自动保存并使用正确的文件名关闭。但是，我找不到将工作表“单词”中的所有信息复制到文档正文中的方法。它正在保存一个空白文档。

在进行故障排除时，我遇到了以下代码：

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 以复制工作表内容会更容易，这也是我更喜欢的。

4

1 回答 1

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

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

于 2012-09-28T18:00:53.653 回答