Dim app As New MSWord.Application
try
Dim doc = app.Documents.Open(ProjectPath & "\Reports\病害整理.doc")
If app.ActiveWindow.Selection.Find.Execute("test") Then '查找word插入文本
'插入表格,方法1
'////////////////生成临时表
Dim dt As New DataTableBuilder("test1")
dt.AddDef("桥梁名称", Gettype(String),32)
dt.AddDef("构件编号", Gettype(String),32)
dt.AddDef("评定项目", Gettype(String),32)
dt.AddDef("缺损情况病害描述", Gettype(String),255)
dt.TableVisible=True
dt.Build()
MainTable= Tables("test1")
'/////////////////////////////////////////////////
Dim tbl As Table = Tables("病害统计表") '定义一个表
Dim Regions As List(Of String()) = tbl.DataTable.GetValues("桥梁名称|桥梁代码|部件名称") '从指定列中,获取不重复的值,以集合的形式返回.
Dim WdLine = MSWord.WdUnits.wdLine
Dim tcount = 2
For Each Region As String() In Regions
Dim Rows As List(Of DataRow) '定义行集合
Rows = tbl.DataTable.Select("[桥梁名称] = '" & Region(0) & "'and [部件名称] = '" & Region(2) & "'")
For Each drr As DataRow In Rows
Dim dr1 As DataRow = DataTables("test1").AddNew()
dr1("桥梁名称") = drr("桥梁名称")
dr1("构件编号") = drr("构件编号")
dr1("评定项目") = drr("评定项目")
dr1("缺损情况病害描述") = drr("缺损情况病害描述")
Next
'////////////////////////////////////////////
doc.Tables.Add(Range:=app.Selection.Range,NumRows:=1, NumColumns:= 4) '返回一个 Table 对象,该对象代表添加至文档中的空白新表格
'///定义表格格式
With app.Selection.Tables(1)
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
.Style = "网格型"
End With
'For Each dc As DataCol In dt.DataCols
For Each dc As DataCol In DataTables("test1").DataCols
app.Selection.TypeText(Text:=dc.Name)
app.Selection.MoveRight(Unit:=12)
Next
' For Each dr As DataRow In dt.DataRows
For Each dr As DataRow In DataTables("test1").DataRows
' For Each dc As DataCol In dt.DataCols
For Each dc As DataCol In DataTables("test1").DataCols
app.Selection.TypeText(Text:=dr(dc.Name))
app.Selection.MoveRight(Unit:=12)
Next
Next
app.Selection.MoveDown(WdLine , tcount, Nothing)
app.Selection.TypeParagraph()
Next
End If
'//////////////////////////////////////////////
app.Visible = True
catch ex As exception
msgbox(ex.message)
app.Quit
finally
End try
加好友 
发短信
Post By：2019/10/27 0:18:00 [只看该作者]
此主题相关图片如下：qq截图20191027000546.png
