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


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

主题:[求助]

美女呀,离线,留言给我吧!
qingqian369
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:婴狐 帖子:22 积分:228 威望:0 精华:0 注册:2016/10/26 12:28:00
[求助]  发帖心情 Post By:2017/7/18 10:56:00 [只看该作者]

请问专家大大,导出具有多层表头的指定列改如何写代码?谢谢

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


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


 回到顶部
美女呀,离线,留言给我吧!
qingqian369
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:婴狐 帖子:22 积分:228 威望:0 精华:0 注册:2016/10/26 12:28:00
[求助]  发帖心情 Post By:2017/7/18 11:22:00 [只看该作者]

不是这个意思,表具有多层表头,想导出指定列之后,表头依然是多层表头~~
导出指定列


      Dim dt As Table = Tables("订单")

Dim nms() As String = {"产品","客户","数量","单价","金额","日期"} '要导出的列名 
Dim caps() As String = {"产品名称","用户名称","数量","单价","金额","日期"} '对应的列标题
Dim szs() As Integer = {100,100,80,80,80,120} '对应的列宽
Dim Book As New XLS.Book '定义一个Excel工作簿
Dim Sheet As XLS.Sheet = Book.Sheets(0) '引用工作簿的第一个工作表
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.Cols(nms(c)).IsDate Then '如果是日期列
        Sheet.Cols(c).Style = st '设置显示格式
    End If
Next
For r As Integer = 0 To dt.Rows.Count - 1 '填入数据
    For c As Integer = 0 To nms.length -1
        Sheet(r +1, c).Value = dt.rows(r)(nms(c))
    Next
Next
Dim dlg As New SaveFileDialog '定义一个新的SaveFileDialog
dlg.Filter= "Excel文件|*.xls" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then
    Book.Save(dlg.FileName)
    Dim Proc As New Process
    Proc.File = dlg.FileName
    Proc.Start()
End If

如果导出具有多层表头的Table的数据,可以参看下面的代码:

Dim tbl As Table = Tables("产品")
Dim hdr As Integer = tbl.HeaderRows '获得表头的层数
Dim cnt As Integer
Dim Book As New XLS.Book 
Dim Sheet As XLS.Sheet = Book.Sheets(0)
tbl.CreateSheetHeader(Sheet) '生成表头
For c As Integer = 0 To tbl.Cols.Count - 1
    If tbl.Cols(c).Visible Then
        For r As Integer = 0 to tbl.Rows.Count - 1
            sheet(r + hdr,cnt).value = tbl(r,c)
        Next
        cnt = cnt + 1
    End If
Next
Book.Save("c:\reports\test.xls")
Dim Proc As New Process
Proc.File = "c:\reports\test.xls"
Proc.Start()


怎么把他俩合并起来,实现导出列


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


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

mark 多层表头

 

Dim dt As Table = Tables("表C")
Dim nms() As String = {"第一列_aa", "第一列_bb", "第一列_cc","第三列", "第四列_a_b", "第四列_a_c"} '要导出的列名
Dim caps() As String = {"第一列_aa", "第一列_bb", "第一列_cc", "第三列","第四列_a_b","第四列_a_c"} '对应的列标题
Dim hlvl As Integer = 3
Dim szs() As Integer = {100,100,80} '对应的列宽
Dim Book As New XLS.Book '定义一个Excel工作簿
Dim Sheet As XLS.Sheet = Book.Sheets(0) '引用工作簿的第一个工作表
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 dt.Rows.Count - 1 '填入数据
    For c As Integer = 0 To nms.length -1
        Sheet(r+hlvl, c).Value = dt.rows(r)(nms(c))
    Next
Next
book.save("d:\test.xls")


 回到顶部
美女呀,离线,留言给我吧!
qingqian369
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:婴狐 帖子:22 积分:228 威望:0 精华:0 注册:2016/10/26 12:28:00
  发帖心情 Post By:2017/7/18 13:42:00 [只看该作者]

非常感谢大大,已用上了,

 回到顶部