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



给定一个未指定的列表 excel 电子表格 A 列中的名称,我想为列表中的每个单独名称创建多个 word 文档。我还希望每个名称成为单词文档的名称,后跟今天的日期,即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对象。需要一些帮助才能开始。谢谢!

我已经测试过这将按照指定创建文件。我留给你研究如何实际填充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

最新更新