Foxtable(狐表)用户栏目专家坐堂 → 请教袍兄


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

主题:请教袍兄

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


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/11/4 10:53:00 [显示全部帖子]

Dim app As New MSWord.Application
try
    Dim doc = app.Documents.add
    Dim dt As DataTable = DataTables("表A")
    doc.Tables.Add(Range:=app.Selection.Range,NumRows:=1, NumColumns:= dt.DataCols.Count)
    With app.Selection.Tables(1)
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = True
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = True
    End With
    For Each dc As DataCol In dt.DataCols
        app.Selection.TypeText(Text:=dc.Name)
        app.Selection.MoveRight(Unit:=12)
    Next
    For Each dr As DataRow In dt.DataRows
        For Each dc As DataCol In dt.DataCols
            app.Selection.TypeText(Text:=dr(dc.Name))
            If dc.IsNumeric Then
                app.Selection.ParagraphFormat.Alignment = 2
            Else
                app.Selection.ParagraphFormat.Alignment = 1
            End If

            app.Selection.MoveRight(Unit:=12)
        Next
    Next
    app.Visible = True
catch ex As exception
    msgbox(ex.message)
    app.Quit
finally
   
End try

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


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/11/4 11:40:00 [显示全部帖子]

Dim app As New MSWord.Application
try
    Dim doc = app.Documents.add
    Dim dt As DataTable = DataTables("表A")
    doc.Tables.Add(Range:=app.Selection.Range,NumRows:=1, NumColumns:= dt.DataCols.Count)
    With app.Selection.Tables(1)
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = True
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = True
    End With
    For Each dc As DataCol In dt.DataCols
        app.Selection.TypeText(Text:=dc.Name)
        app.Selection.MoveRight(Unit:=12)
    Next
    For Each dr As DataRow In dt.DataRows
        For Each dc As DataCol In dt.DataCols
            app.Selection.TypeText(Text:=dr(dc.Name))
            Dim i As Double
            If Double.TryParse(dr(dc.name),i)
                app.Selection.ParagraphFormat.Alignment = 2
            Else
                app.Selection.ParagraphFormat.Alignment = 1
            End If
            app.Selection.MoveRight(Unit:=12)
        Next
    Next
    app.Visible = True
catch ex As exception
    msgbox(ex.message)
    app.Quit
finally
   
End try


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


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/11/4 14:36:00 [显示全部帖子]

Dim app As New MSWord.Application
try
    Dim doc = app.Documents.add
    Dim dt As DataTable = DataTables("表A")
    doc.Tables.Add(Range:=app.Selection.Range,NumRows:=1, NumColumns:= dt.DataCols.Count)
    With app.Selection.Tables(1)
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = True
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = True
    End With
    For Each dc As DataCol In dt.DataCols
        app.Selection.TypeText(Text:=dc.Name)
        app.Selection.MoveRight(Unit:=12)
    Next
    For i As Integer = 0 To dt.datarows.count-1
        Dim dr As DataRow = dt.datarows(i)
        for j as integer = 0 to dt.datacols.count - 1
            dim dc as datacol = dt.datacols(i)
            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 = dt.datarows.count-1 AndAlso j = dt.datacols.count-1
                '不做操作
            Else
                app.Selection.MoveRight(Unit:=12)
                End If
            Next
        Next
        app.Visible = True
    catch ex As exception
        msgbox(ex.message)
        app.Quit
    finally
       
    End try

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


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/11/4 17:27:00 [显示全部帖子]

Dim app As New MSWord.Application
try
    Dim doc = app.Documents.add
    Dim dt As DataTable = DataTables("表A")
    doc.Tables.Add(Range:=app.Selection.Range,NumRows:=1, NumColumns:= dt.DataCols.Count)
    With app.Selection.Tables(1)
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = True
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = True
    End With
    For Each dc As DataCol In dt.DataCols
        app.Selection.TypeText(Text:=dc.Name)
        app.Selection.MoveRight(Unit:=12)
    Next
    For i As Integer = 0 To dt.datarows.count-1
        Dim dr As DataRow = dt.datarows(i)
        For j As Integer = 0 To dt.datacols.count - 1
            Dim dc As DataCol = dt.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 = dt.datarows.count-1 AndAlso j = dt.datacols.count-1
                '不做操作
            Else
                app.Selection.MoveRight(Unit:=12)
            End If
        Next
    Next
    app.Visible = True
catch ex As exception
    msgbox(ex.message)
    app.Quit
finally
   
End try

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


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/11/4 19:14:00 [显示全部帖子]

            If i = dt.datarows.count-1 AndAlso j = dt.datacols.count-1
                '不做操作
            Else
                app.Selection.MoveRight(Unit:=12)
            End If

 


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


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/11/4 19:45:00 [显示全部帖子]

Dim tm = "d:\test.doc"
Dim bm = "test"
Dim dttable = DataTables("表A")

Dim app As New MSWord.Application
try
    Dim doc = app.Documents.Open(tm)
    If app.ActiveWindow.Selection.Find.Execute("" & bm & "") Then
        '插入表格,方法1或2
        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
    End If
    app.Documents(tm).save
    app.quit
catch ex As exception
    app.Quit
finally
End try


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


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/11/4 20:08:00 [显示全部帖子]

可以用table啊,只要匹配,就可以啊。比如dt必须是table;

 

行的次序,你可以排序嘛。比如先用select排序得到drs集合,再循环drs。


 回到顶部