批量转化EXCEL表单到WORD表格中

 我所在公司的文管中心使用了一个系统，可以搜索列出生产所需要的一些资料，生成的是一个EXCEL文件，可是进行ISO流程时需要使用一个WORD模板做成一个WORD文件，并且必须使用该模板的表格形式，一个两个文件还好处理，可是每天那么多个文件，实在不是一件简单的事情，因此作了一个小程序帮她们进行转换。

界面如下：

文本框分别命名为：TXTXLS、TXTDOC

选择按钮分别命名为：SELXLS、SELDOC

一、目录选择

弹出文件夹选择框，这部分网上比较多例子，代码略去。

不过需要保证目录的最后一个字母为“”，不然可能导致文件这个路径不正确。

二、具体转换代码如下：

（引用中需要增加：MICROSOFT WORD/EXCEL OBJECT LIBRARY）

Dim wordApp As Object ‘WORD应用程序对象

Dim wordDoc As Variant ‘WORD所打开的文档对象

Set wordApp = new Word.Application ‘创建WORD应用程序对象

Dim ixlsnum As Long ‘EXCEL文件的记录行数

Dim jcol As Integer ‘EXCEL文件的记录列数

Dim xlsFile As String

xlsFile = Dir(txtxls.Text + "*.xls") ‘查找第一个XLS文件

Dim xlApp As Object

Set xlApp = New Excel.Application ‘创建EXCEL应用程序对象

Dim xlBook As Object ‘EXCEL所打开的EXCEL对象

While xlsFile <> "" ‘如果找到XLS文件

Set wordDoc = wordApp.Documents.Open(strAppDir + "tmp.dot") ‘打开模板文档

wordDoc.SaveAs txtdoc.Text + Left(xlsFile, Len(xlsFile) - 3) + "doc" 

‘另存为与EXCEL文件同名的DOC文档

Set xlBook = xlApp.Workbooks.Open(txtxls.Text + xlsFile) ‘打开XLS文件

For ixlsnum = 3 To xlBook.Worksheets(1).Rows.Count

‘因为我使用的XLS文件从第三行开始才是真正的数据，循环到当前表单所有行数

If (xlBook.Worksheets(1).Cells(ixlsnum, 1) = "") Then

Exit For

End If 

‘这个判断是因为xlBook.Worksheets(1).Rows.Count似乎总是65535，因此判断

必须的第一列是否有数据，如果没有就跳出

If ixlsnum >= 5 Then

wordDoc.Tables(1).Rows.Add

End If

‘由于我的模板表格只有两行，所以当读取XLS表超过两行后，增加WORD模板表格的行数

For jcol = 1 To xlBook.Worksheets(1).Columns.Count

‘循环XLS表的所有列 

If (jcol <> 6) And jcol <> 7 And xlBook.Worksheets(1).Cells(ixlsnum, jcol)_
 <> "" Then ‘因为对应的WORD没有6/7列，所以进行判断

wordDoc.Tables(1).Cell(ixlsnum - 2, jcol) = 

xlBook.Worksheets(1).Cells(ixlsnum, jcol)

‘将XLS表的值赋值给WORD模板表格相应的行、列

‘因为从第三行开始读取XLS表格，所以要减2

End If

Next

Next

WordDoc.Save ‘保存DOC文档

wordDoc.Close ‘关闭DOC文档

xlBook.Close ‘关闭XLS文件

xlsFile = Dir() ‘查找下一个XLS文件

end

wordApp.Quit ‘退出WORD程序

xlApp.Quit ‘退出EXCEL程序

Set xlApp = Nothing

Set xlBook = Nothing

Set wordDoc = Nothing

Set wordApp = Nothing‘释放对象