1. 插入行之后，将字体取消粗体，标示黄色的代码有问题，请帮忙指点；
2. 表格中的行高能根据内容自动调整；
3. 若当前页不够是，能自动换页并插入表格；
Dim dr As Row = Tables("T_Report").Current
Dim bh As String = dr("报告格式编号")
Dim bz As String
bz = DataTables("T_Item").GetComboListString("标准","报告编号 = '"& dr("报告编号") &"'")
Dim tm As String = ProjectPath & "Attachments\DGN\" & bh & ".doc" '指定模板文件
Dim fl As String = ProjectPath & "Reports\" & dr("报告编号") & " " & dr("样品名称") & ".Doc" '指定目标文件
Dim wrt As New WordReport(Tables("T_Report"),tm,fl) '定义一个WordReport
wrt.BuildOne(dr)
wrt.Quit
Dim app As New MSWord.Application
try
Dim fileName = ProjectPath & "Reports\" & dr("报告编号") & " " & dr("样品名称") & ".Doc" '指定目标文件
Dim doc As Object = app.Documents.Open(fileName)
app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekCurrentPageHeader
If app.Selection.Find.Execute("CTTREPORT") Then '查找到指定字符串
app.Selection.Text =" " & dr("报告编号") & "" '替换字符串
End If
app.Activedocument.Bookmarks("项目清单").Range.Tables(1).Select
Dim xh As Integer = 0
Dim zrs As List(of DataRow) = DataTables("T_Item").Select("报告编号 = '"& dr("报告编号") &"'")
For Each zr As DataRow In zrs
xh = xh + 1
app.Selection.InsertRowsBelow(1)
app.Selection.Font.Bold = app.wdToggle
app.Selection.MoveRight(Unit:=12)
app.Selection.TypeText(Text:=xh)
app.Selection.MoveRight(Unit:=12)
app.Selection.TypeText(Text:=zr("检测项目"))
app.Selection.MoveRight(Unit:=12)
app.Selection.TypeText(Text:=zr("检测方法"))
app.Selection.MoveRight(Unit:=12)
app.Selection.TypeText(Text:=zr("结果"))
app.Selection.MoveRight(Unit:=12)
app.Selection.TypeText(Text:=zr("标准要求"))
app.Selection.MoveRight(Unit:=12)
app.Selection.TypeText(Text:=zr("单位"))
app.Selection.MoveRight(Unit:=12)
app.Selection.TypeText(Text:=zr("判定"))
Next
app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekMainDocument
app.Visible = True
catch ex As exception
msgbox(ex.message)
app.Quit
finally
'app.Quit
End try
加好友 
发短信
Post By：2019/7/22 8:54:00 [只看该作者]
