楼主
kevinchengcw |
Q: 如何用vba代码对word文档进行格式转换？（实例）
A: 代码如下：
- Type mTable '定义自定义类型用于存储相关信息
- Title As String
- No As String
- Ver As String
- Date As String
- Page As String
- Content As String
- End Type
- Sub test()
- Dim FN$, DOC As Document, Source As mTable, RegEx As Object
- Set RegEx = CreateObject("vbscript.regexp") '创建正则项目,用于替换掉多余的结尾,word表格里取出的不知为何有个多余的尾巴
- With RegEx
- .Global = True '全局有效
- .MultiLine = True '多行有效
- .Pattern = "\s*\s*" '匹配空白字符与圆点构成的字符串
- End With
- If Dir(ThisDocument.Path & "\new\", vbDirectory) = "" Then MkDir ThisDocument.Path & "\new\" '查询是否有存储文件夹,没有就建一个
- FN = Dir(ThisDocument.Path & "\*.doc?") '枚举当前目录下的文档
- Do While FN <> ""
- If FN <> ThisDocument.Name And FN <> "模板.doc" Then '如果不是本文件或模板文件,则进行处理
- With Source '初始化一下,防止处理不同文件时信息混淆
- .Title = ""
- .No = ""
- .Ver = ""
- .Date = ""
- .Page = ""
- .Content = ""
- End With
- Set DOC = GetObject(ThisDocument.Path & "\" & FN) '隐藏打开当前循环到的文档
- With DOC.Tables(1) '采集第一个表格里的内容存入对应数据项中
- Source.Title = RegEx.Replace(.Cell(1, 2).Range.Text, "")
- Source.No = RegEx.Replace(.Cell(2, 2).Range.Text, "")
- Source.Ver = RegEx.Replace(.Cell(2, 4).Range.Text, "")
- Source.Date = RegEx.Replace(.Cell(2, 6).Range.Text, "")
- Source.Page = RegEx.Replace(.Cell(2, 7).Range.Text, "")
- Source.Content = RegEx.Replace(.Cell(3, 1).Range.Text, "")
- End With
- DOC.Close False '关闭文档
- CreateObject("wscript.shell").Run Environ("comspec") & " /c copy """ & ThisDocument.Path & "\模板.doc"" """ & ThisDocument.Path & "\new\" & FN & """ /y", 0, 1 '复制一份模板到new目录下并命名为与当前循环到的文档同名
- Set DOC = Documents.Open(ThisDocument.Path & "\new\" & FN) '打开新建的文档
- With DOC
- .Activate '激活
- ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader '打开页眉视图
- With Selection.Tables(1) '将对应内容放入页眉的表中
- .Cell(1, 2).Range.Text = Source.Title
- .Cell(1, 4).Range.Text = Source.No
- .Cell(2, 3).Range.Text = Source.Date
- .Cell(2, 5).Range.Text = Source.Ver
- .Cell(2, 7).Range.Text = Source.Page
- End With
- ActiveWindow.ActivePane.View.Type = wdNormalView '到普通视图,将正文写入
- .Range.Text = Source.Content
- End With
- DOC.Close True '保存并关闭文档
- End If
- FN = Dir '循环到下一个
- Loop
- Set DOC = Nothing '清空创建的项目
- Set RegEx = Nothing
- End Sub
详细内容请参见源帖。
http://www.exceltip.net/thread-17232-1-1.html
|
