根据指定内容，打开模版，生成文档

597633464

各位大师
本人小白，会一些公式，VBA就会录制宏。{:soso_e101:}
每月需要建立一些员工生产档案。
员工数量太多，手动太慢了。
实在没有办法了，上个月光这个工作都做了2天，自己想录制代码，开始录制的代码不能用。
希望：在附件demo文件里面自定义选择工号（或者工号和姓名），确定后，代码自动打开当前路径下的模版文件（有2个工作表），将员工姓名和工号填到封面表格对应表格中，并保存，文件名为“员工产能-姓名 工号”，
每个员工一个文件。

不知道描述的清楚不清楚。具体可以参考附件。
麻烦各位大师了，谢谢！{:soso_e183:}

597633464

不知道这样的要求是不是很过分？
能不能实现

huang1314wei

楼主，你的要求不过分，很简单，一会给你发上来

feiren228

597633464 发表于 2015-9-23 17:10
不知道这样的要求是不是很过分？
能不能实现

把模版直接放在数据文件里

1. Sub test()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim arr, i&, j&, r&
   
5.     With Sheet1
   
6.         r = .Cells.Find("*", Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
   
7.         arr = .Range("A1:E" & r)
   
8.     End With
   
9.     For i = 3 To UBound(arr)
   
10.         If Len(arr(i, 2)) Then
    
11.             With Sheets("封面")
    
12.                 .[b3] = arr(i, 3)
    
13.                 .[b4] = arr(i, 2)
    
14.             End With
    
15.             With Sheets("统计表")
    
16.                 .[b1] = arr(i, 3)
    
17.                 .[b2] = arr(i, 2)
    
18.             End With
    
19.             Sheets(Array("封面", "统计表")).Copy
    
20.             ActiveWorkbook.SaveAs ThisWorkbook.Path & "\员工产能-" & arr(i, 3) & arr(i, 2), xlExcel8
    
21.             ActiveWorkbook.Close
    
22.         End If
    
23.     Next i
    
24.     Application.ScreenUpdating = True
    
25.     Application.DisplayAlerts = True
    
26. End Sub

复制代码

feiren228

附件。
demo-test.zip (18.79 KB, 下载次数: 29)

2015-9-23 17:58 上传

点击文件名下载附件

huang1314wei

1. Sub text()
   
2.     Dim arr, i%, wb As Workbook
   
3.     Application.ScreenUpdating = False
   
4.     arr = Range("A1").CurrentRegion
   
5.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\模版.xlsx")
   
6.     With wb.Sheets(1)
   
7.     For i = 3 To UBound(arr)
   
8.         .Range("B3") = arr(i, 3)
   
9.         .Range("B4").NumberFormatLocal = "@"
   
10.         .Range("B4") = arr(i, 2)
    
11.         wb.SaveAs Filename:=ThisWorkbook.Path & "\员工产能-" & arr(i, 3) & " " & arr(i, 2) & ".xlsx"
    
12.     Next
    
13.     .Parent.Close False
    
14.     End With
    
15.     Application.ScreenUpdating = True
    
16. End Sub

复制代码

huang1314wei

附件参考：

批量复制.rar (22.16 KB, 下载次数: 24)

2015-9-23 17:59 上传

点击文件名下载附件

huang1314wei

如果统计表中也要填姓名和工号，代码如下：

1. Sub text()
   
2.     Dim arr, i%, wb As Workbook
   
3.     Application.ScreenUpdating = False
   
4.     arr = Range("A1").CurrentRegion
   
5.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\模版.xlsx")
   
6.     With wb.Sheets(1)
   
7.     For i = 3 To UBound(arr)
   
8.         .Range("B3") = arr(i, 3)
   
9.         .Range("B4").NumberFormatLocal = "@"
   
10.         .Range("B4") = arr(i, 2)
    
11.         .Parent.Sheets(2).Range("A1") = .Range("B3")
    
12.         .Range("B3").Copy .Parent.Sheets(2).Range("A2")
    
13.         wb.SaveAs Filename:=ThisWorkbook.Path & "\员工产能-" & arr(i, 3) & " " & arr(i, 2) & ".xlsx"
    
14.     Next
    
15.     .Parent.Close False
    
16.     End With
    
17.     Application.ScreenUpdating = True
    
18. End Sub

复制代码

huang1314wei

统计表中也会有姓名和工号
附件如下：
批量复制2.rar (23.23 KB, 下载次数: 21)

2015-9-23 18:07 上传

点击文件名下载附件

597633464

feiren228 发表于 2015-9-23 17:57
把模版直接放在数据文件里

谢谢，我先学习下。