使用VBA复制来自excel的单个单元格中的名称,并为每个名称创建/保存新的word文档

时间:2017-03-23 21:15:49

标签: excel vba excel-vba

如果在excel电子表格的A列中列出了未指定的列表名称,我想为列表中的每个单独的名称创建多个word文档。我还希望每个名称成为doc字的名称,后跟今天的日期,即Michael_03232017.docx

我已经查找了类似问题的例子,但它们都太复杂了,因为我还是初学者。除了设置需要迭代的单元格范围外,我无法上手。

以下是我的开始:

Sub WordDocTransf()
    Dim Rng As Range
    Dim wdAPP As Object
    Dim wdDoc As Object

    set Rng = Worksheets("Sheet1").Range("A1:A" & Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "A".End(xlup).Row)

End Sub

我不知道如何实现wdAPP和wdDoc对象。 需要一些帮助入门请。谢谢!

1 个答案:

答案 0 :(得分:0)

我已经测试过这将创建指定的文件。我留给你研究如何实际填充Word文档。

Sub WordDocTransf()
    Dim dateStr As String
    Dim Rng As Range
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim lastRow As Long

    lastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
    Set Rng = ActiveSheet.Range("A1:A" & lastRow)

    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True

    For Each cell In Rng
        Set wrdDoc = wrdApp.Documents.Add

        dateStr = "_" & Format(Month(Date), "00") & Format(Day(Date), "00") & CStr(Year(Date))

        With wrdDoc
            If Dir("C:\your_folder\" & cell.Value & dateStr & ".doc") <> "" Then
                Kill "C:\your_folder\" & cell.Value & dateStr & ".doc"
            End If
            .SaveAs ("C:\your_folder\" & cell.Value & dateStr & ".doc")
            .Close
        End With
    Next
    wrdApp.Quit
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub