'操控Word文档,主要是文档合并
'*******************************
'*********以下代码可修改**********
Dim FileName = "复件 干部审计通知.doc" '定义模版文件名
Dim Ctn As String = "干部审计" '当前表表名,通用格式Functions.Execute("CurrentTableName")
Dim Tb As Table = Tables(Ctn) '定义当前表,通用.
'*********以上代码可修改**********
'*******************************
If FileSys.DirectoryExists(ProjectPath & "Reports\") = False Then '如果Reports文件夹不存在
FileSys.CreateDirectory(ProjectPath & "Reports\") '创建Reports文件夹
End If
Dim App As New MSWord.Application '定义MSWord
Try
'获得模版
Dim nDoc = App.Documents.Open(ProjectPath & "Attachments\" & FileName)
Dim count = App.Documents(FileName).Characters.Count
Dim rng As MSWord.Range = App.Documents(FileName).Range(Start:=0, End:=count)
rng.Select() '全选
rng.Copy() '拷贝
nDoc.Activate()
'插入文段
Dim idx As Integer = 0
If Tb.Rows.Count > 0 Then
For i As Integer = Tb.TopPosition To Tb.BottomPosition
Dim cr As Row = Tb.Rows(i)
If idx >= 1 Then
rng = nDoc.Range(start:=0, End:=0) '从后面前面粘贴
rng.Paste
End If
'***********************************************
'*********以下是代码主体部分,需要修改**********
App.Selection.Find.ClearFormatting()
App.Selection.Find.Text = "[审计通知]"
App.Selection.Find.Replacement.ClearFormatting()
App.Selection.Find.Replacement.Text = cr("审计通知")
App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)
App.Selection.Find.ClearFormatting()
App.Selection.Find.Text = "[审计年度]"
App.Selection.Find.Replacement.ClearFormatting()
App.Selection.Find.Replacement.Text = cr("审计年度")
App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)
App.Selection.Find.ClearFormatting()
App.Selection.Find.Text = "[文号]"
App.Selection.Find.Replacement.ClearFormatting()
App.Selection.Find.Replacement.Text = cr("文号")
App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)
App.Selection.Find.ClearFormatting()
App.Selection.Find.Text = "[委托时间]"
App.Selection.Find.Replacement.ClearFormatting()
App.Selection.Find.Replacement.Text = Format(cr("委托时间"),"yyyy年M月d日")
App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)
'*********以上是代码主体部分,需要修改**********
'**********************************************
idx += 1
Next
End If
nDoc.SaveAs(ProjectPath & "Reports\" & FileName)
Catch ex As exception
msgbox(ex.message)
Finally
App.Quit
End Try
Dim Proc As New Process
Proc.File = ProjectPath & "Reports\" & FileName
Proc.Start()
上述代码通过测试正常，分享给大家
加好友 
发短信
Post By：2013/9/1 21:17:00 [显示全部帖子]
