所以我有这个宏,它可以将单个表从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