专家坐堂-用代码直接在word中生成表格Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  用代码直接在word中生成表格  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=142433)

--  作者：12397522011
--  发布时间：2019/10/27 0:18:00
--  用代码直接在word中生成表格

目的是用代码直接在word中生成如图1所示的表格，结果生成了图2的样子，求指点问题出在哪块
图1

此主题相关图片如下：qq截图20191027000546.png
图2

此主题相关图片如下：qq截图20191027000419.png

//////////////////生成表格的代码
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("桥梁名称|桥梁代码|部件名称") \'从指定列中,获取不重复的值,以集合的形式返回.
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
Next
End If
\'//////////////////////////////////////////////
app.Visible = True
catch ex As exception
msgbox(ex.message)
app.Quit
finally
End try

--  作者：有点蓝
--  发布时间：2019/10/27 20:30:00
--

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

--  作者：12397522011
--  发布时间：2019/10/27 22:15:00
--

找见问题了，循环位置有问题。谢谢

[此贴子已经被作者于2019/10/27 22:37:15编辑过]

--  作者：有点蓝
--  发布时间：2019/10/27 22:31:00
--

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