首页 Soft PlugIn RAN乱 Dev开发 Info资料 English WAP 留言 登陆 注册
-
Posted by Yippee | 评论(0) | 引用(0) | 阅读3889次
批量转化EXCEL表单到WORD表格中

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

界面如下:

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

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

一、目录选择
弹出文件夹选择框,这部分http://www.shengfang.org网上比较多例子,代码略去。

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

二、具体转换http://www.shengfang.org代码如下:
(引用中需要增加: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文件的http://www.shengfang.org记录行数

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对象http://www.shengfang.org

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

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

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

‘另存为与EXCEL文件同名的DOC文档http://www.shengfang.org

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

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

‘因为我使用的XLS文件从第三行开始才是真正的数据,http://www.shengfang.org循环到当前表单所有行数

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

Exit For

End If

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

必须的第一列是否有数据,如果没有就跳出http://www.shengfang.org

If ixlsnum >= 5 Then

wordDoc.Tables(1).Rows.Add

End If

‘由于我的模板表格只有两行,http://www.shengfang.org所以当读取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列,所以进行判断http://www.shengfang.org

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

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

‘将XLS表的值赋值给WORD模板表格相应的行、列http://www.shengfang.org

‘因为从第三行开始读取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‘释放对象

http://www.shengfang.org


字体:

Permanant URI永久地址 http://www.shengfang.org/blog/p/vbexcel2word.php
Trackback URI引用地址 http://www.shengfang.org/blog/tb.php?tb_id=1110431378

2005年3月10日13:09星期四  [Dev开发] 追踪此文的RSS
提示:
此文还没有评论。

称呼:    登陆   注册
   不注册,但记住我的信息
邮件:
(非必须)
评论: [UBB代码帮助]
粗体 斜体 下划线 链接 水平线 引用



验证码: 请输入你看见的数字
关闭UBB      提交时自动将内容复制到剪贴板

公告
Fire and Motion!

统计信息
[Yippee]||[统计]||日志:1790
在线: 7||用户: 2563 [列表]
今日:693||到访:2682332
Rss:841978||评论:1585

最新日志

最新评论

友情链接

日历

最新引用

搜索

归档

杂项
Get RSS Feed (Version 2.0)
Get Atom Feed (Version 0.3)
编码:  UTF-8