问题
I am now exporting a range of cells into Word using a macro in excel.
There are some changes though as I need it to instead copy this to a NEW Word document and not an existing one that is in the script?
My range that is selected is made up of various Vlookup results.
Also, if possible, I want to get the file name to be whatever is in A1.
Sub Export_Table_Data_Word()
'Name of the existing Word document
Const stWordDocument As String = "Table Report.docx"
'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell
'Excel objects
Dim wbBook As Workbook
Dim wsSheet As Worksheet
'Count used in a FOR loop to fill the Word table.
Dim lnCountItems As Long
'Variant to hold the data to be exported.
Dim vaData As Variant
'Initialize the Excel objects
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet1")
vaData = wsSheet.Range("A1:A10").Value
'Instantiate Word and open the "Table Reports" document.
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)
lnCountItems = 1
'Place the data from the variant into the table in the Word doc.
For Each wdCell In wdDoc.Tables(1).Columns(1).Cells
wdCell.Range.Text = vaData(lnCountItems, 1)
lnCountItems = lnCountItems + 1
Next wdCell
'Save and close the Word doc.
With wdDoc
.Save
.Close
End With
wdApp.Quit
'Null out the variables.
Set wdCell = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "The " & stWordDocument & "'s table has succcessfully " & vbNewLine & _
"been updated!", vbInformation
End Sub
UPDATE:
Thank you Nicholas for the assistance. Below the final script:
Sub OLDMACROADJUSTED()
'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell
'Excel objects
Dim wbBook As Workbook
Dim wsSheet As Worksheet
'Count used in a FOR loop to fill the Word table.
Dim lnCountItems As Long
'Variant to hold the data to be exported.
Dim vaData As Variant
'File path based on A1'
Dim filePath As String
filePath = "C:\FolderName\" & Cells(1, 1).Value & ".doc"
'Initialize the Excel objects
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet1")
vaData = wsSheet.Range("A1:A10").Value
'Instantiate Word and open the new file.
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Add 'Create new app instead of open'
lnCountItems = 1
Dim c As Range
For Each c In Range("B3:B7")
wrdDoc.Content.InsertAfter c
Next c
'Place the data from the variant into the table in the Word doc.
'For Each wdCell In wdDoc.Tables(1).Columns(1).Cells
'wdCell.Range.Text = vaData(lnCountItems, 1)
'lnCountItems = lnCountItems + 1
'Next wdCell
'Save and close the Word doc.
With wrdDoc
If Dir(filePath) <> "" Then
Kill filePath
End If
.SaveAs (Range("B3").Value)
.Close ' close the document
End With
'wdApp.Quit
'Null out the variables.
Set wdCell = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "Your file has been saved in default location of the macro...", vbInformation
End Sub
回答1:
Try this code out:
Sub Export_Table_Data_Word()
'Name of the existing Word document
' Const stWordDocument As String = "Table Report.docx"
'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell
'Excel objects
Dim wbBook As Workbook
Dim wsSheet As Worksheet
'Count used in a FOR loop to fill the Word table.
Dim lnCountItems As Long
'Variant to hold the data to be exported.
Dim vaData As Variant
'File path based on A1'
Dim filePath As String
filePath = "C:\FolderName\" & Cells(1, 1).Value & ".doc"
'Initialize the Excel objects
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet1")
vaData = wsSheet.Range("A1:A10").Value
'Instantiate Word and open the new file.
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Add 'Create new app instead of open'
lnCountItems = 1
'Place the data from the variant into the table in the Word doc.
For Each wdCell In wdDoc.Tables(1).Columns(1).Cells
wdCell.Range.Text = vaData(lnCountItems, 1)
lnCountItems = lnCountItems + 1
Next wdCell
'Save and close the Word doc.
With wrdDoc
If Dir(filePath) <> "" Then
Kill filePath
End If
.SaveAs (filePath)
.Close ' close the document
End With
wdApp.Quit
'Null out the variables.
Set wdCell = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "The " & stWordDocument & "'s table has succcessfully " & vbNewLine & _
"been updated!", vbInformation
End Sub
All that I changed was adding a filePath variable to store the file path (including the value found in A1), changed wdDoc to be a new document instead of opening an old one, and reconfigured the saving of the file to make sure the file isn't open before trying to save.
Here's where I got the most of the code.
Test code:
Sub CreateNewWordDoc()
' to test this code, paste it into an Excel module
' add a reference to the Word-library
' create a new folder named C:\Foldername or edit the filnames in the code
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim i As Integer
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Add
' or
'Set wrdDoc = wrdApp.Documents.Open("C:\Foldername\Filename.doc")
' sample word operations
With wrdDoc
For i = 1 To 100
.Content.InsertAfter "Here is a sample test line #" & i
.Content.InsertParagraphAfter
Next i
If Dir("C:\Foldername\MyNewWordDoc.doc") <> "" Then
Kill "C:\Foldername\MyNewWordDoc.doc"
End If
.SaveAs ("C:\Foldername\MyNewWordDoc.doc")
.Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub
来源：https://stackoverflow.com/questions/31032325/save-export-from-range-in-excel-to-word-and-save-as-name-in-cell-a1