VBA多条EXCEL记录写入到WORD文档中

jjxworld

已于 2023-03-21 22:15:59 修改

阅读量5.8k

点赞数 4

分类专栏： VBA 文章标签： excel word

于 2023-01-05 17:23:06 首次发布

本文链接：https://blog.youkuaiyun.com/jjxworld/article/details/128567113

版权

VBA 专栏收录该内容

2 篇文章

订阅专栏

要点提示：

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 '是否取得外国国籍


'***************家庭主要成员*******************