Foxtable(狐表)用户栏目专家坐堂 → [求助]导出


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

主题:[求助]导出

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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/12/2 21:19:00 [显示全部帖子]

修改红色代码

 

Dim dt As Table = Tables("订单管理")
dt.filter = "发货状态=true and 订单状态=true"

 


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/12/3 8:52:00 [显示全部帖子]

Dim dlg As New SaveFileDialog '定义一个新的SaveFileDialog
dlg.Filter= "Excel文件|*.xls" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then
    Dim dt As DataTable = DataTables("订单管理")
    Dim nms() As String = {"订单编号","订单日期","客户名称"} '要导出的列名
    Dim caps() As String = {"订单编号","订单日期","客户名称"} '对应的列标题
    Dim szs() As Integer = {100,100,100,100} '对应的列宽
    Dim Book As New XLS.Book '定义一个Excel工作簿
    For Each mc As String In dt.GetValues("客户名称", "发货状态=true and 订单状态=true and 客户名称 is not null")
        Dim Sheet As XLS.Sheet = Book.Sheets.Add '引用工作簿的第一个工作表
        sheet.name = mc
        Dim drs = dt.Select("客户名称='" & mc & "' and 发货状态=true and 订单状态=true")
        Dim st As XLS.Style = Book.NewStyle '日期列的显示格式
        st.Format = "yyyy-MM-dd"
        For c As Integer = 0 To nms.length -1
            Sheet(0, c).Value = caps(c) '指定列标题
            Sheet.Cols(c).Width = szs(c) '指定列宽
            If dt.dataCols(nms(c)).IsDate Then '如果是日期列
                Sheet.Cols(c).Style = st '设置显示格式
            End If
        Next
        For r As Integer = 0 To drs.Count - 1 '填入数据
            For c As Integer = 0 To nms.length -1
                Sheet(r +1, c).Value = drs(r)(nms(c))
            Next
        Next
    Next
    book.Sheets.RemoveAt(0)
    Book.Save(dlg.FileName)
    Dim Proc As New Process
    Proc.File = dlg.FileName
    Proc.Start()
End If

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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/12/3 10:14:00 [显示全部帖子]


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/12/3 13:19:00 [显示全部帖子]


Dim dt As DataTable = DataTables("订单管理")
Dim nms() As String = {"订单_编号","订单_日期","客户名称"} '要导出的列名
Dim caps() As String = {"订单_编号","订单_日期","客户名称"} '对应的列标题
Dim hlvl As Integer = 2
Dim szs() As Integer = {100,100,100,100} '对应的列宽
Dim Book As New XLS.Book '定义一个Excel工作簿
For Each mc As String In dt.GetValues("客户名称", "发货状态=true and 订单状态=true and 客户名称 is not null")
    Dim Sheet As XLS.Sheet = Book.Sheets.Add '引用工作簿的第一个工作表
    sheet.name = mc
    Dim drs = dt.Select("客户名称='" & mc & "' and 发货状态=true and 订单状态=true")
    Dim st As XLS.Style = Book.NewStyle '日期列的显示格式
    st.Format = "yyyy-MM-dd"
    For c As Integer = 0 To nms.length -1
        Sheet(0, c).Value = caps(c) '指定列标题
        Sheet.Cols(c).Width = szs(c) '指定列宽
        If dt.dataCols(nms(c)).IsDate Then '如果是日期列
            Sheet.Cols(c).Style = st '设置显示格式
        End If
    Next
   
   
   
   
   
    '================
    Dim jz As xls.style = book.NewStyle
    jz.AlignHorz = XLS.AlignHorzEnum.Center
    jz.AlignVert = XLS.AlignVertEnum.Center
    For c As Integer = 0 To nms.length -1
        Dim ary() As String = caps(c).split("_")
        For i As Integer = 0 To ary.length-1
            sheet(i, c).value = ary(i)
            sheet(i, c).Style = jz
        Next
    Next
    For i As Integer = 0 To hlvl-1
        Dim pi As Integer = 0
        For c As Integer = 0 To nms.length -2
            If sheet(i,c).text = sheet(i,c+1).text Then
                Dim flag As Boolean = True
                For k As Integer = i-1 To 0 Step -1
                    If sheet(k,c).value <> sheet(k,c+1).value Then
                        flag = False
                    End If
                Next
                If flag Then
                    pi += 1
                Else
                    pi = 0
                End If
            Else
                sheet.MergeCell(i, c-pi, 1, pi+1)
                pi = 0
            End If
        Next
        sheet.MergeCell(i, nms.length-pi-1, 1, pi+1)
    Next
   
    For c As Integer = 0 To nms.length -1
        Dim pi As Integer = 0
        For i As Integer = hlvl-1 To 0 Step -1
            If sheet(i, c).text = "" Then
                pi += 1
            Else
                sheet.MergeCell(i, c, pi+1, 1)
                Exit For
            End If
        Next
    Next
    '-----------------------
    For r As Integer = 0 To drs.Count - 1 '填入数据
        For c As Integer = 0 To nms.length -1
            Sheet(r+hlvl, c).Value = drs(r)(nms(c))
        Next
    Next
Next
book.Sheets.RemoveAt(0)
Dim f = "d:\test.xls"
Book.Save(f)
Dim Proc As New Process
Proc.File = f
Proc.Start()

 


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/12/4 8:57:00 [显示全部帖子]

在这个位置设置样式

 

    For r As Integer = 0 To drs.Count - 1 '填入数据
        For c As Integer = 0 To nms.length -1
            Sheet(r+hlvl, c).Value = drs(r)(nms(c))
        Next
    Next


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/12/4 9:32:00 [显示全部帖子]

Sheet(r+hlvl, c).Value = drs(r)(nms(c))

 

改成

 

Sheet(r+hlvl, c).Value = drs(r)(nms(c))

Sheet(r+hlvl, c).style = jz

[此贴子已经被作者于2018/12/4 9:32:34编辑过]

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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/12/4 10:50:00 [显示全部帖子]

Dim dt As DataTable = DataTables("订单管理")
Dim nms() As String = {"订单_编号","订单_日期","客户名称","数量","单价","合计"} '要导出的列名
Dim caps() As String = {"订单_编号","订单_日期","客户名称","数量","单价","合计"} '对应的列标题
Dim hlvl As Integer = 2
Dim szs() As Integer = {100,100,100,100,100,100} '对应的列宽
Dim Book As New XLS.Book '定义一个Excel工作簿
For Each mc As String In dt.GetValues("客户名称", "发货状态=true and 订单状态=true and 客户名称 is not null")
    Dim Sheet As XLS.Sheet = Book.Sheets.Add '引用工作簿的第一个工作表
    sheet.name = mc
    Dim drs = dt.Select("客户名称='" & mc & "' and 发货状态=true and 订单状态=true")
    Dim st As XLS.Style = Book.NewStyle '日期列的显示格式
    st.AlignHorz = XLS.AlignHorzEnum.Center
    st.AlignVert = XLS.AlignVertEnum.Center
    st.BorderTop = XLS.LineStyleEnum.Thin  '返回或设置上边框的类型.
    st.BorderBottom = XLS.LineStyleEnum.Thin  '返回或设置下边框的类型.
    st.BorderLeft = XLS.LineStyleEnum.Thin    '返回或设置左边框类型
    st.BorderRight = XLS.LineStyleEnum.Thin    '返回或设置右边框类型
    st.BorderColorTop = Color.Red
    st.BorderColorBottom = Color.Red
    st.BorderColorLeft = Color.Red
    st.BorderColorRight = Color.Red
    st.Format = "yyyy-MM-dd"
    For c As Integer = 0 To nms.length -1
        Sheet(0, c).Value = caps(c) '指定列标题
        Sheet.Cols(c).Width = szs(c) '指定列宽
    Next
   
    Dim jz As xls.style = book.NewStyle
    jz.AlignHorz = XLS.AlignHorzEnum.Center
    jz.AlignVert = XLS.AlignVertEnum.Center
    jz.BorderTop = XLS.LineStyleEnum.Thin  '返回或设置上边框的类型.
    jz.BorderBottom = XLS.LineStyleEnum.Thin  '返回或设置下边框的类型.
    jz.BorderLeft = XLS.LineStyleEnum.Thin    '返回或设置左边框类型
    jz.BorderRight = XLS.LineStyleEnum.Thin    '返回或设置右边框类型
    jz.BorderColorTop = Color.Red
    jz.BorderColorBottom = Color.Red
    jz.BorderColorLeft = Color.Red
    jz.BorderColorRight = Color.Red
    Book.DefaultFont = New Font("微软雅黑",12) '设置默认字体
   
    'For r As Integer = 0 To 5
    ' For c As Integer =0 To 5
    ' Sheet(r,c).style = jz
    'Next
    'Next
   
    For c As Integer = 0 To nms.length -1
        Dim ary() As String = caps(c).split("_")
        For i As Integer = 0 To ary.length-1
            sheet(i, c).value = ary(i)
        Next
        For i As Integer = 0 To hlvl-1
            sheet(i, c).Style = jz
        Next
    Next
    For i As Integer = 0 To hlvl-1
        Dim pi As Integer = 0
        For c As Integer = 0 To nms.length -2
            If sheet(i,c).text = sheet(i,c+1).text Then
                Dim flag As Boolean = True
                For k As Integer = i-1 To 0 Step -1
                    If sheet(k,c).value <> sheet(k,c+1).value Then
                        flag = False
                    End If
                Next
                If flag Then
                    pi += 1
                Else
                    pi = 0
                End If
            Else
                sheet.MergeCell(i, c-pi, 1, pi+1)
                pi = 0
            End If
        Next
        sheet.MergeCell(i, nms.length-pi-1, 1, pi+1)
    Next
    For c As Integer = 0 To nms.length -1
        Dim pi As Integer = 0
        For i As Integer = hlvl-1 To 0 Step -1
            If sheet(i, c).text = "" Then
                pi += 1
            Else
                sheet.MergeCell(i, c, pi+1, 1)
                Exit For
            End If
        Next
    Next
    For r As Integer = 0 To drs.Count - 1 '填入数据
        For c As Integer = 0 To nms.length -1
            Sheet(r+hlvl, c).Value = drs(r)(nms(c))
            If dt.DataCols(nms(c)).IsDate Then
                Sheet(r+hlvl, c).style = st
            Else
                Sheet(r+hlvl, c).style = jz
            End If
        Next
    Next
Next
book.Sheets.RemoveAt(0)
Dim f = "h:\test.xls"
Book.Save(f)
Dim Proc As New Process
Proc.File = f
Proc.Start()

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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/12/5 9:14:00 [显示全部帖子]

以下是引用江南小镇在2018/12/4 20:16:00的发言:
 谢谢老师,导出表头能设置样式吗?

 

你要设置怎样的样式?这里设置的就是表头的样式

 

    For c As Integer = 0 To nms.length -1
        Dim ary() As String = caps(c).split("_")
        For i As Integer = 0 To ary.length-1
            sheet(i, c).value = ary(i)
        Next
        For i As Integer = 0 To hlvl-1
            sheet(i, c).Style = jz
        Next
    Next


 回到顶部