将excel中的范围导出保存为Word并保存为单元格A1中的名称

我现在使用excel中的macros将一系列单元格导出到Word中。

有一些变化，但我需要它而不是复制这个新的Word文档，而不是在脚本中的现有的一个？

我select的范围是由各种Vlookup结果组成的。

另外，如果可能的话，我想要得到的文件名是任何在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 

更新：

谢谢尼古拉斯的帮助。 在最后的脚本下面：

 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 

Answer 1

试试这个代码：

 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 

所有我改变的是添加一个filePathvariables来存储文件path（包括在A1find的值），改变wdDoc是一个新的文件，而不是打开一个旧的，并重新configuration文件的保存，以确保该文件isn在尝试保存之前不会打开。

这是我获得最多代码的地方。

testing代码：

 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