如何从excel生成单词报告?

时间:2017-11-21 06:49:46

标签: excel vba excel-vba ms-word word-vba

我想将以下excel内容转换为word文档。 新单词报告包含学生姓名,日期,科目,原始考试时间和新考试时间。 enter image description here enter image description here

我试图用一种简单的方法来做到这一点。复制范围(a79:L85)&范围(A90:L92)到新单词文档。但它不起作用并将两个表连接在一起(进入同一行)。

    Sub ExcelRangeToWord()

'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run _
  (VBE > Tools > References > Microsoft Word 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com

Dim tbl As Excel.RANGE
Dim tbl2 As Excel.RANGE
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Copy Range from Excel
  Set tbl = ThisWorkbook.Worksheets(sheet9.Name).RANGE("A79:L85") 'copy the name ,subject and old exam time 
  Set tbl2 = ThisWorkbook.Worksheets(sheet99.Name).RANGE("A90:L92")'copy the new exam time 
'Create an Instance of MS Word
  On Error Resume Next

    'Is MS Word already opened?
      Set WordApp = GetObject(Class:="Word.Application")

    'Clear the error between errors
      Err.Clear

    'If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(Class:="Word.Application")

    'Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        GoTo EndRoutine
      End If

  On Error GoTo 0

'Make MS Word Visible and Active
  WordApp.Visible = True
  WordApp.Activate

'Create a New Document
  Set myDoc = WordApp.Documents.Add


'Copy Excel Table Range
  tbl.Copy ' paste range1
  tbl2.Copy 'paste range2

'Paste Table into MS Word
  myDoc.Paragraphs(1).RANGE.PasteExcelTable _
    LinkedToExcel:=False, _
    WordFormatting:=False, _
    RTF:=False

'Autofit Table so it fits inside Word Document
  Set WordTable = myDoc.Tables(1)
  WordTable.AutoFitBehavior (wdAutoFitWindow)

EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub

任何提示或方法都可以生成这样的单词报告吗?

1 个答案:

答案 0 :(得分:0)

这可能只是解释如何一个接一个地复制+粘贴表的解决方案的一部分。

'....
'Trigger copy separately for each table + paste for each table

    tbl.Copy ' paste range1
    myDoc.Paragraphs(1).Range.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=False, _
        RTF:=False

'before that...
'...go to end of doc and add new paragraph
    myDoc.Bookmarks("\EndOfDoc").Range.InsertParagraphAfter
    tbl2.Copy 'paste range2

'Paste Table into MS Word last paragraph
    myDoc.Paragraphs(myDoc.Paragraphs.Count).Range.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=False, _
        RTF:=False