以文本方式查看主题
- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- [求助]如何将表中的所有数据生成Word (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=109482)
|
-- 作者:clchen
-- 发布时间:2017/11/13 15:10:00
-- [求助]如何将表中的所有数据生成Word
请问如何将foxtable表中所有的数据一次性按照格式生成word如图:
|
-- 作者:有点甜
-- 发布时间:2017/11/13 15:21:00
--
参考代码
Dim dttable = DataTables("表A")
Dim app As New MSWord.Application try Dim doc = app.Documents.add Dim dt2 As DataTable = dttable doc.Tables.Add(Range:=app.Selection.Range,NumRows:=1, NumColumns:= dt2.DataCols.Count) With app.Selection.Tables(1) .ApplyStyleHeadingRows = True .ApplyStyleLastRow = True .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = True .Style = "网格型" End With For Each dc As DataCol In dt2.DataCols app.Selection.TypeText(Text:=dc.Name) Dim i As Double If Double.TryParse(dc.name,i) app.Selection.ParagraphFormat.Alignment = 2 Else app.Selection.ParagraphFormat.Alignment = 1 End If app.Selection.MoveRight(Unit:=12) Next For i As Integer = 0 To dt2.datarows.count-1 Dim dr As DataRow = dt2.datarows(i) For j As Integer = 0 To dt2.datacols.count - 1 Dim dc As DataCol = dt2.datacols(j) app.Selection.TypeText(Text:=dr(dc.Name)) Dim d As Double If Double.TryParse(dr(dc.name),d) app.Selection.ParagraphFormat.Alignment = 2 Else app.Selection.ParagraphFormat.Alignment = 1 End If If i = dt2.datarows.count-1 AndAlso j = dt2.datacols.count-1 Else app.Selection.MoveRight(Unit:=12) End If Next Next app.visible = True catch ex As exception app.Quit finally
End try
|
-- 作者:clchen
-- 发布时间:2017/11/13 15:29:00
--
这段代码是什么意思?有点不明白?这里如何生成word???
|
-- 作者:有点甜
-- 发布时间:2017/11/13 15:58:00
--
改成自己的表名,执行看结果,然后慢慢看懂代码
Dim dttable = DataTables("表A")
Dim app As New MSWord.Application try Dim doc = app.Documents.add Dim dt2 As DataTable = dttable doc.Tables.Add(Range:=app.Selection.Range,NumRows:=1, NumColumns:= dt2.DataCols.Count) With app.Selection.Tables(1) .ApplyStyleHeadingRows = True .ApplyStyleLastRow = True .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = True .Style = "网格型" End With For Each dc As DataCol In dt2.DataCols app.Selection.TypeText(Text:=dc.Name) Dim i As Double If Double.TryParse(dc.name,i) app.Selection.ParagraphFormat.Alignment = 2 Else app.Selection.ParagraphFormat.Alignment = 1 End If app.Selection.MoveRight(Unit:=12) Next For i As Integer = 0 To dt2.datarows.count-1 Dim dr As DataRow = dt2.datarows(i) For j As Integer = 0 To dt2.datacols.count - 1 Dim dc As DataCol = dt2.datacols(j) app.Selection.TypeText(Text:=dr(dc.Name)) Dim d As Double If Double.TryParse(dr(dc.name),d) app.Selection.ParagraphFormat.Alignment = 2 Else app.Selection.ParagraphFormat.Alignment = 1 End If If i = dt2.datarows.count-1 AndAlso j = dt2.datacols.count-1 Else app.Selection.MoveRight(Unit:=12) End If Next Next app.visible = True catch ex As exception app.Quit finally
End try
|
-- 作者:clchen
-- 发布时间:2017/11/13 16:02:00
--
这个要如何将表名称换行啊?如我上面截图的哪样格式?
|
-- 作者:有点甜
-- 发布时间:2017/11/13 16:19:00
--
无语,你能不能看懂代码后处理?
不会做,那请具体表格发上来测试。
[此贴子已经被作者于2017/11/13 16:19:21编辑过]
|
-- 作者:clchen
-- 发布时间:2017/11/13 16:26:00
--
请帮忙做出上面word截图的格式,非常感谢
|
-- 作者:有点甜
-- 发布时间:2017/11/13 17:08:00
--
Dim t = Tables("表A") Dim cname = "第一列"
Dim app As New MSWord.Application try Dim doc = app.Documents.add app.Selection.font.Size = 20 \'字号 app.Selection.font.Bold = True \'加粗 app.Selection.TypeText(Text:="xxx系统表结构" & vbcrlf) app.Selection.font.Size = 9 \'字号 app.Selection.font.Bold = False For k As Integer = 0 To t.Rows.count-1 If t.Rows(k).IsNull(cname) = False Then app.Selection.TypeText(Text:=t.Rows(K)(cname) & vbcrlf) Dim tb = doc.Tables.Add(Range:=app.Selection.Range,NumRows:=1, NumColumns:= t.Cols.Count-1) With tb .ApplyStyleHeadingRows = True .ApplyStyleLastRow = True .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = True .Style = "网格型" End With For Each dc As Col In t.Cols If dc.name <> cname Then app.Selection.TypeText(Text:=dc.Name) Dim i As Double If Double.TryParse(dc.name,i) app.Selection.ParagraphFormat.Alignment = 2 Else app.Selection.ParagraphFormat.Alignment = 1 End If app.Selection.MoveRight(Unit:=12) End If Next For i As Integer = k To t.rows.count-1 Application.doevents Dim dr As Row = t.rows(i) If i > K AndAlso t.Rows(i).IsNull(cname) = False Then k = i-1 app.Selection.MoveRight(Unit:=1,count:=1) app.ActiveWindow.Selection.TypeParagraph app.Selection.MoveRight(Unit:=1,count:=1) app.ActiveWindow.Selection.TypeParagraph Exit For ElseIf i>k Then app.Selection.MoveRight(Unit:=12) End If output.show(i) For j As Integer = 0 To t.Cols.count - 1 Dim dc As Col = t.Cols(j) If dc.name <> cname Then app.Selection.TypeText(Text:=dr(dc.Name)) Dim d As Double If Double.TryParse(dr(dc.name),d) app.Selection.ParagraphFormat.Alignment = 2 Else app.Selection.ParagraphFormat.Alignment = 1 End If If j = t.cols.count-1 Else app.Selection.MoveRight(Unit:=12) End If End If Next Next End If Next app.visible = True catch ex As exception msgbox(ex.message) app.Quit finally End try
|
-- 作者:clchen
-- 发布时间:2017/11/13 17:14:00
--
非常感谢!
|
-- 作者:kgdce
-- 发布时间:2018/3/21 12:34:00
--
很好例子
|