以文本方式查看主题

-  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=109482)
--  作者：clchen
--  发布时间：2017/11/13 15:10:00
--  [求助]如何将表中的所有数据生成Word
请问如何将foxtable表中所有的数据一次性按照格式生成word
如图：

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

图片点击可在新窗口打开查看此主题相关图片如下：e_l2kzjob%f9md65g2ul2@e.png
图片点击可在新窗口打开查看
--  作者：有点甜
--  发布时间：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截图的格式，非常感谢
 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目1.foxdb
--  作者：有点甜
--  发布时间：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
--  
很好例子