使用VBA / Apache POI将多个表从Excel导出到模板Word文档

时间:2017-01-19 12:15:46

标签: java excel vba excel-vba apache-poi

所以我有这个宏,它可以将单个表从Excel工作表复制到模板Word文档。如何修改它,以便它可以将6个不同的Excel工作表中的6个表复制到模板Word文档中?或者我可以使用Apache POI API将多个表从Excel复制到Word吗?

Sub ExportDataToWord()
  Worksheets("Val Balance Sheet").Range("A1:D22").Copy
  Dim wdapp, wddoc As Object

  Dim strdocname As String
  On Error Resume Next
  Set wdapp = GetObject(, "Word.Application")
  If Err.Number = 429 Then
    Err.Clear
    Set wdapp = CreateObject("Word.Application")
  End If

  wdapp.Visible = True
  strdocname = "C:\Users\ako\report.docx"
  If Dir(strdocname) = "" Then
    MsgBox "The file " & strdocname & vbCrLf & "was not found " & vbCrLf & "C:\Users\ako\.", vbExclamation, "The document does not exist."
    Exit Sub
  End If

  wdapp.Activate
  Set wddoc = wdapp.documents.Open(strdocname)
  If wddoc Is Nothing Then Set wddoc = wdapp.DocumentOpen(strdocnme)
  wddoc.Activate
  wddoc.Range.Paste
  wddoc.Save
  wdapp.Quit

  Set wddoc = Nothing
  Set wdapp = Nothing
  Application.CutCopyMode = False

End Sub

继续对我现在正在尝试的内容进行更新,但它只是将第二个表格粘贴到Word模板中?这里需要修改的内容是允许它粘贴多个单词而不覆盖第一个表。

 Sub ExportToWord()

 Worksheets("Val Balance Sheet").Range("A1:D22").Copy
 Dim wdapp, wddoc As Object

 Dim strdocname As String
 On Error Resume Next
 Set wdapp = GetObject(, "Word.Application")
 If Err.Number = 429 Then Err.Clear
 Set wdapp = CreateObject("Word.Application")
 End If

 wdapp.Visible = True
 strdocname = "C:\Users\ako\report.docx"
 If Dir(strdocname) = "" Then
MsgBox "The file " & strdocname & vbCrLf & "was not found " & vbCrLf & "C:\Users\ako\.", vbExclamation, "The document does not exist."
 Exit Sub
 End If

 wdapp.Activate
 Set wddoc = wdapp.documents.Open(strdocname)
 If wddoc Is Nothing Then Set wddoc = wdapp.DocumentOpen(strdocnme)
 wddoc.Activate
 wddoc.Range.Paste


 Worksheets("Template Gains and Losses").Range("A1:C11").Copy
 Dim wdapp2, wddoc2 As Object

 Dim strdocname2 As String
 On Error Resume Next
 Set wdapp2 = GetObject(, "Word.Application")
 If Err.Number = 429 Then
 Err.Clear
 Set wdapp2 = CreateObject("Word.Application")
 End If

 wdapp2.Visible = True
 strdocname2 = "C:\Users\ako\report.docx"
 If Dir(strdocname2) = "" Then
 MsgBox "The file " & strdocname2 & vbCrLf & "was not found " & vbCrLf & "C:\Users\ako\.", vbExclamation, "The document does not exist."
 Exit Sub
 End If

 wdapp2.Activate
 Set wddoc2 = wdapp.documents.Open(strdocname)
 If wddoc2 Is Nothing Then Set wddoc2 = wdapp2.DocumentOpen(strdocnme2)
 wddoc2.Activate
 wddoc2.Range.Paste


 wddoc.Save
 wdapp.Quit

 Set wddoc = Nothing
 Set wdapp = Nothing
 Application.CutCopyMode = False

 End Sub

0 个答案:

没有答案