我有两个部分工作的代码组合在一起。
我有一个标记为'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
与第一个代码完全相反:它将打开一个新文档(而不是模板),将完美地复制所有数据,但不会保存或关闭正确的文件名。
我猜测更新代码第一部分以复制工作表内容会更容易,这也是我更喜欢的。
答案 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
这有效:但不会从我的模板打开。尽管如此 - 它将从一个工作表创建一个文档,并自动将其保存到目录中,并在定义的单元格中引用文件名。