将Excel中范围的导出保存到Word，并保存为单元格A1中的名称 [英] Save export from range in excel to Word and save as name in Cell A1

问题描述

我现在正在使用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

更新:

谢谢尼古拉斯(Nicholas)的协助.在最终脚本下方:

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

解决方案

尝试以下代码:

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更改为一个新文档，而不是打开一个旧文档，然后重新配置保存文件，以确保在尝试保存之前未打开文件.

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

测试代码:

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

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

解决方案

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

这篇关于将Excel中范围的导出保存到Word，并保存为单元格A1中的名称的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！