Foxtable(狐表)用户栏目专家坐堂 → [求助]如何将表中的所有数据生成Word


  共有2609人关注过本帖树形打印复制链接

主题:[求助]如何将表中的所有数据生成Word

帅哥哟,离线,有人找我吗?
clchen
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:241 积分:1750 威望:0 精华:0 注册:2016/5/20 12:55:00
[求助]如何将表中的所有数据生成Word  发帖心情 Post By:2017/11/13 15:10:00 [只看该作者]

请问如何将foxtable表中所有的数据一次性按照格式生成word
如图:

图片点击可在新窗口打开查看此主题相关图片如下:a@~4xlm(hqc(4(28wp7890z.png
图片点击可在新窗口打开查看

图片点击可在新窗口打开查看此主题相关图片如下:e_l2kzjob%f9md65g2ul2@e.png
图片点击可在新窗口打开查看


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By: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
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:241 积分:1750 威望:0 精华:0 注册:2016/5/20 12:55:00
  发帖心情 Post By:2017/11/13 15:29:00 [只看该作者]

这段代码是什么意思?有点不明白?这里如何生成word???

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By: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
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:241 积分:1750 威望:0 精华:0 注册:2016/5/20 12:55:00
  发帖心情 Post By:2017/11/13 16:02:00 [只看该作者]

这个要如何将表名称换行啊?如我上面截图的哪样格式?

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/11/13 16:19:00 [只看该作者]

无语,你能不能看懂代码后处理?

 

不会做,那请具体表格发上来测试。

[此贴子已经被作者于2017/11/13 16:19:21编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
clchen
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:241 积分:1750 威望:0 精华:0 注册:2016/5/20 12:55:00
  发帖心情 Post By:2017/11/13 16:26:00 [只看该作者]

请帮忙做出上面word截图的格式,非常感谢
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目1.foxdb


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By: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
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:241 积分:1750 威望:0 精华:0 注册:2016/5/20 12:55:00
  发帖心情 Post By:2017/11/13 17:14:00 [只看该作者]

非常感谢!

 回到顶部
帅哥哟,离线,有人找我吗?
kgdce
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:三尾狐 帖子:627 积分:6899 威望:0 精华:0 注册:2013/12/17 1:00:00
  发帖心情 Post By:2018/3/21 12:34:00 [只看该作者]

很好例子

 回到顶部