要点提示:
1、批量EXCEL记录
2、WORD表格模板(一个WORD表格)
3、为每一条记录生成一个独立的WORD表格
Sub Excel2Word()
Application.ScreenUpdating = False
p = ThisWorkbook.Path & "/" '根目录路径
Dim myWS As Worksheet
Set myWS = ThisWorkbook.Sheets(1) '存有数据的表格
Const Loct As Integer = 10000 '定义常量
Dim iCount(Loct) As String, numCount(Loct) As String, nameCount(Loct) As String, postCount(Loct) As String
Dim strColum As String, fDate As String, fMonth As String, fDay As String
Dim modeFilse As String
Dim j As Integer, i As Integer, Ct As Integer, postLen As Integer
strColum = ""
Ct = 0
For j = 0 To Loct '统计数据记录总条数
iCount(j) = Sheets("Sheet1").Range("B5").Offset(j, 0)
If (Trim(iCount(j)) <> "") Then '检查B列数据是否为空,非空即统计
numCount(j) = Sheets("Sheet1").Range("A5").Offset(j, 0)
Ct = Ct + 1
strColum = strColum & iCount(j) & ","
End If
Next j
'MsgBox strColum & Ct
'fDate = Format(Now(), "yyyy-mm-dd")
modeFilse = p & "公司代表大会人员登记表.doc" 'WORD文档表格模板
f = modeFilse '选择模板文件
If (Ct > 0) Then
For i = 5 To (Ct + 4) '遍历数据行数,EXCEL记录从第5行开始
FileCopy f, p & "生成的文件/" & myWS.Cells(i, 1).Text & myWS.Cells(i, 2).Text & ".doc" '复制空模板并以某列数据为名命名新产生的文档
Set wd = CreateObject("word.application")
Set d = wd.documents.Open(p & "生成的文件/" & myWS.Cells(i, 1).Text & myWS.Cells(i, 2).Text & ".doc") '打开新文档
d.tables(1).Cell(1, 2) = myWS.Cells(i, 2).Text '写入姓名
d.tables(1).Cell(1, 4) = myWS.Cells(i, 3).Text '性别
d.tables(1).Cell(1, 6) = myWS.Cells(i, 4).Text '出生年月
d.tables(1).Cell(2, 2) = myWS.Cells(i, 5).Text '民族
d.tables(1).Cell(2, 4) = myWS.Cells(i, 6).Text '籍贯
d.tables(1).Cell(2, 6) = myWS.Cells(i, 8).Text '党派
d.tables(1).Cell(3, 2) = myWS.Cells(i, 17).Text
d.tables(1).Cell(3, 4) = "广州"
d.tables(1).Cell(4, 2) = "组织提名"
d.tables(1).Cell(4, 4) = "健康"
d.tables(1).Cell(4, 6) = myWS.Cells(i, 9).Text '参加工作时间
d.tables(1).Cell(5, 2) = myWS.Cells(i, 11).Text '职称
d.tables(1).Cell(5, 4) = myWS.Cells(i, 13).Text '学历学位
d.tables(1).Cell(5, 6) = "" '所学专业
d.tables(1).Cell(5, 8) = myWS.Cells(i, 12).Text '个人特长
d.tables(1).Cell(6, 2) = myWS.Cells(i, 16).Text '毕业院校
d.tables(1).Cell(6, 4) = myWS.Cells(i, 18).Text '身份证号码
d.tables(1).Cell(7, 2) = myWS.Cells(i, 19).Text '所属结构
d.tables(1).Cell(8, 2) = myWS.Cells(i, 22).Text '电子信箱
d.tables(1).Cell(8, 4) = "" '微信号
d.tables(1).Cell(9, 2) = myWS.Cells(i, 20).Text '通讯地址
d.tables(1).Cell(9, 4) = myWS.Cells(i, 26).Text '手 机
d.tables(1).Cell(10, 2) = myWS.Cells(i, 21).Text '邮 编
d.tables(1).Cell(10, 4) = myWS.Cells(i, 23).Text '传真
d.tables(1).Cell(10, 6) = myWS.Cells(i, 24).Text '办公电话
d.tables(1).Cell(11, 2) = myWS.Cells(i, 27).Text '工作单位及现任(或原任)职务
d.tables(1).Cell(12, 2) = myWS.Cells(i, 28).Text '简历
d.tables(1).Cell(13, 2) = myWS.Cells(i, 29).Text '主要表现
d.tables(1).Cell(14, 2) = myWS.Cells(i, 67).Text + myWS.Cells(i, 68).Text + myWS.Cells(i, 69).Text '选举结果
d.tables(1).Cell(22, 2) = myWS.Cells(i, 30).Text '现任或历任职务情况(地方、届次、任期起止时间)
d.tables(1).Cell(23, 2) = "" '备注
'***************家庭主要成员*******************
d.tables(1).Cell(16, 2) = myWS.Cells(i, 31).Text '称谓
d.tables(1).Cell(16, 3) = myWS.Cells(i, 32).Text '姓名
d.tables(1).Cell(16, 4) = myWS.Cells(i, 33).Text '出生年月
d.tables(1).Cell(16, 5) = myWS.Cells(i, 34).Text '政治面貌
d.tables(1).Cell(16, 6) = myWS.Cells(i, 35).Text '工作单位及职务
d.tables(1).Cell(16, 7) = myWS.Cells(i, 35).Text '是否取得外国国籍
d.tables(1).Cell(17, 2) = myWS.Cells(i, 37).Text '称谓
d.tables(1).Cell(17, 3) = myWS.Cells(i, 38).Text '姓名
d.tables(1).Cell(17, 4) = myWS.Cells(i, 39).Text '出生年月
d.tables(1).Cell(17, 5) = myWS.Cells(i, 40).Text '政治面貌
d.tables(1).Cell(17, 6) = myWS.Cells(i, 41).Text '工作单位及职务
d.tables(1).Cell(17, 7) = myWS.Cells(i, 42).Text '是否取得外国国籍
d.tables(1).Cell(18, 2) = myWS.Cells(i, 43).Text '称谓
d.tables(1).Cell(18, 3) = myWS.Cells(i, 44).Text '姓名
d.tables(1).Cell(18, 4) = myWS.Cells(i, 45).Text '出生年月
d.tables(1).Cell(18, 5) = myWS.Cells(i, 46).Text '政治面貌
d.tables(1).Cell(18, 6) = myWS.Cells(i, 47).Text '工作单位及职务
d.tables(1).Cell(18, 7) = myWS.Cells(i, 48).Text '是否取得外国国籍
d.tables(1).Cell(19, 2) = myWS.Cells(i, 49).Text '称谓
d.tables(1).Cell(19, 3) = myWS.Cells(i, 50).Text '姓名
d.tables(1).Cell(19, 4) = myWS.Cells(i, 51).Text '出生年月
d.tables(1).Cell(19, 5) = myWS.Cells(i, 52).Text '政治面貌
d.tables(1).Cell(19, 6) = myWS.Cells(i, 53).Text '工作单位及职务
d.tables(1).Cell(19, 7) = myWS.Cells(i, 54).Text '是否取得外国国籍
d.tables(1).Cell(20, 2) = myWS.Cells(i, 55).Text '称谓
d.tables(1).Cell(20, 3) = myWS.Cells(i, 56).Text '姓名
d.tables(1).Cell(20, 4) = myWS.Cells(i, 57).Text '出生年月
d.tables(1).Cell(20, 5) = myWS.Cells(i, 58).Text '政治面貌
d.tables(1).Cell(20, 6) = myWS.Cells(i, 59).Text '工作单位及职务
d.tables(1).Cell(20, 7) = myWS.Cells(i, 60).Text '是否取得外国国籍
'***************家庭主要成员*******************
d.Close
wd.Quit
Set wd = Nothing
Next i
Application.ScreenUpdating = True
Else
MsgBox "没有数据!"
End If
End Sub