保存從Excel中的範圍導出到Word並保存爲單元格A1的名稱

Question

我現在使用excel中的宏將一系列單元格導出到Word中。

雖然有一些變化，但我需要它將其複製到新的Word文檔中，而不是腳本中的現有文檔？

我選擇的範圍由各種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 

UPDATE：

謝謝尼古拉斯的幫助。下面的最終腳本：

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 

所有，我改變是增加了filePath變量來存儲文件的路徑（包括A1找到的值），改變wdDoc到成爲新文檔而不是打開舊文檔，並重新配置文件的保存以確保文件在嘗試保存前未打開。

Here's where I got the most of the 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