VBA应用

01 工作表

按Excel表格中某列的人员名单、批量创建名字命名的word文档

Question：

Excel有一列100个名字，我想根据100个名字创建word文件，咋办？

Answer1：

这类的office协同问题，VBA在合适不过了，简单快捷！

运行视频：

源码下载：

示例代码

复制成功!


Sub 客户信息批量新建word文档()

    '自定义数据类型
    Dim File_Path As String, Save_Path As String
    File_Path = ThisWorkbook.Path '获取当前文件所在的路径
    Save_Path = File_Path & "\"   '文件的保存路径，即当前文件夹

    '获取员工数据
    Dim ws As Worksheet
    Dim Row_count As Long, i As Long
    Set ws = ThisWorkbook.Sheets("姓名")                   '替换成保存姓名的excel表名
    Row_count = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    Dim wdap As Object, wddoc As Object, wdtab As Object

    ' 禁用屏幕更新和警告
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wdap = CreateObject("Word.Application")              ' 创建 Word 应用

    With wdap
        .Visible = False                                     ' 后台运行
        For i = 2 To Row_count             '循环处理每一条姓名
            .Documents.Add                 '添加word文档

            .ActiveDocument.SaveAs Save_Path & ws.Cells(i, 1) & "、" & ws.Cells(i, 2).Value & ".docx"  '保存文档，命名为 “序号 + 姓名”
            .ActiveDocument.Close SaveChanges:=True       '关闭文档

        Next i
    End With

    ' 恢复屏幕更新和警告
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "完成"  '过程结束告知！

End Sub