首页 > Excel, Word > Excel做的公文自动生成系统

Excel做的公文自动生成系统

2009年5月9日

为管理公文而作的一个系统,去除了每次找公文号的烦恼,word模板采用国家公文标准。此模板不一定对所有公司实用,可自行修改!打开Excel文件时如果提示宏安全警告,请点击Excel菜单[工具]-[选项]-[安全性]-宏安全性,将宏安全性设为“中”即可。请下载附件研究!

公文自动生成系统

原代码如下:

 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' WordOutPut_Click Macro ' ' 宏由 NeverQuest 录制,时间: 2008-11-22,E-Mail:520156@163.com,QQ:1105057 ' ' ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub WordOutPut_Click() '判断数据完整性,防止误操作,不完整即不执行 If Range("D25") = "注意:信息填写不完整,不能输出!" Then Exit Sub On Error Resume Next '声明Word应用程序对象及文档对象 Dim WordAPP As Object, myWord As Object '变量获取当前路径 Dim myPath As String '变量存放新纪录所在的行数 Dim CurrentRow As Integer '变量存放文号 Dim CurrentNum As String '获取工作簿路径 myPath = ThisWorkbook.Path '实例化Word对象,从模板生成新文件 Set WordAPP = CreateObject("Word.Application") Set myWord = WordAPP.Documents.Open(Filename:=myPath & "\公文模板.DOT") '记录文档数据到数据库 CurrentRow = Range("数据区").Rows.Count + 1 CurrentNum = Range("文号") ' 解密数据库 Sheets("数据库").Unprotect Password:=CurrentRow - 1 ' 写入数据到数据库 With Sheets("数据库") .Cells(CurrentRow, 1) = CurrentRow - 1 .Cells(CurrentRow, 2) = CurrentNum .Cells(CurrentRow, 3) = Range("标题") .Cells(CurrentRow, 4) = Range("主题词") .Cells(CurrentRow, 5) = Range("主送") .Cells(CurrentRow, 6) = Range("抄送") .Cells(CurrentRow, 7) = Range("密级") .Cells(CurrentRow, 8) = Range("保存期限") .Cells(CurrentRow, 9) = Range("紧密程度") .Cells(CurrentRow, 10) = Range("共印份数") .Cells(CurrentRow, 11) = Range("附件1") .Cells(CurrentRow, 12) = Range("附件2") .Cells(CurrentRow, 13) = Range("签发人") .Cells(CurrentRow, 14) = Range("内容") End With ' 加密数据库,防止误操作 Sheets("数据库").Protect Password:=CurrentRow '开始向WORD文件写入内容 myWord.Bookmarks("文号").Range = CurrentNum myWord.Bookmarks("文件头").Range = Range("公司名称") & "文件" myWord.Bookmarks("标题").Range = Range("标题") myWord.Bookmarks("主题词").Range = Range("主题词") myWord.Bookmarks("主送").Range = Range("主送") myWord.Bookmarks("抄送").Range = Range("抄送") myWord.Bookmarks("密级和保存期限").Range = Range("密级") & Range("保存期限") myWord.Bookmarks("紧密程度").Range = Range("紧密程度") myWord.Bookmarks("共印份数").Range = Range("共印份数") myWord.Bookmarks("附件1").Range = Range("附件1") myWord.Bookmarks("附件2").Range = Range("附件2") myWord.Bookmarks("内容").Range = Range("内容") myWord.Bookmarks("签发人").Range = Range("签发人") '工作表界面更新 Range("标题") = "" Range("主题词") = "" Range("主送") = "" Range("抄送") = "" Range("密级") = "" Range("保存期限") = "" Range("紧密程度") = "" Range("共印份数") = "" Range("附件1") = "" Range("附件2") = "" Range("内容") = "" Range("签发人") = "" '新文档以文号命名保存[可根据需求以主题命名] myWord.SaveAs Filename:=myPath & "\" & CurrentNum & ".DOC" '设置应用程序Word可见 WordAPP.Visible = True '以下部分注释掉,方便用户手动操作 ' myWord.Close ' WordAPP.Quit ' Set myWord = Nothing ' Set WordAPP = Nothing End Sub 

下载:公文自动生成系统  (鼠标右键,另存为下载)

转自我在ExcelHome论坛发表的文章,原文地址:http://club.excelhome.net/thread-372794-1-1.html

作者: 分类: Excel, Word 标签: , ,
声明:本站遵循 署名-非商业性使用-相同方式共享 3.0 共享协议. 转载请注明转自 执子之手与子偕老
  1. 本文目前尚无任何评论.
  1. 本文目前尚无任何 trackbacks 和 pingbacks.