Rss & SiteMap

Foxtable(狐表) http://www.foxtable.com

新一代数据库软件,完美融合Access、Foxpro、Excel、vb.net之优势,人人都能掌握的快速软件开发工具!
共3 条记录, 每页显示 10 条, 页签: [1]
[浏览完整版]

标题:关于折叠表的动态导出问题

1楼
刘效功天津 发表于:2025/1/3 9:17:00
专家
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:老师好.关于折叠表输出问题docx.zip

老师好,关于动态折叠表导出数据时出现问题,具体描述在附件中,请老师看看代码哪儿出问题了,谢谢老师!
2楼
有点蓝 发表于:2025/1/3 10:56:00
去掉全部代码,试试

'生成复选组合框列表项目代码

Dim ckl As WinForm.CheckedListBox = e.Form.Controls("lbk")
Dim cmd As New SQLCommand
Dim dt As DataTable
cmd.CommandText = "select distinct 项目内容辅助列 From {工程造价汇总表} where 工程量 > 0  and  项目内容辅助列 in ('全隐框玻璃幕墙单价分析表','全明框玻璃幕墙单价分析表','半明半隐框玻璃幕墙单价分析表')" 
dt = cmd.ExecuteReader()
ckl.ComboList = dt.GetComboListString("项目内容辅助列")


'导出按钮代码
Dim dlg As New SaveFileDialog
dlg.filter = "Excel文件|*.xls"
dlg.OverwritePrompt = True '弹出覆盖警告
If dlg.ShowDialog = DialogResult.OK Then
    
    '定义点击不同单选框按钮时对应的列名显示代码
    Dim lms() As String
    Dim szs() As Integer
    If e.Form.Controls("导出理论数据").Checked = True Then
        lms = {"序号", "科目编码", "项目构成", "单位", "理论用量", "理论单价", "理论合价", "备注"} '要导出的列名
        szs = {150, 200, 80, 80, 120, 120, 120, 120, 120, 120, 120, 120, 120} '对应的列宽
        
    Else If e.Form.Controls("导出投标数据").Checked = True Then
    lms = {"序号", "科目编码", "项目构成", "单位", "投标用量", "投标单价", "投标合价", "备注"} '要导出的列名
    szs = {150, 200, 80, 80, 120, 120, 120, 120, 120, 120, 120, 120, 120} '对应的列宽
    
    Else If e.Form.Controls("导出理论数据").Checked = False And e.Form.Controls("导出投标数据").Checked = False Then 
        MessageBox.Show("请选择导出数据的形式:是导出理论数据   还是导出投标数据")
        
    End If
    
    '下面代码都是定义导出数据表代码
    Dim dt As Table = Tables("报表形式导出表格_table1")
    Dim Book As New XLS.Book '定义一个Excel工作簿
    Dim Sheet As XLS.Sheet
    
    '定义复选组合框列表选择代码
    Dim ckl As WinForm.CheckedListBox = e.Form.Controls("lbk")
    Dim nms As New List(Of String)
    For i As Integer = 0 To ckl.Items.count - 1 '获取已经勾选的表名
        If ckl.GetItemChecked(i) Then
            nms.Add(ckl.Items(i))
            
        End If
    Next
    If nms.Count = 0 Then
        MessageBox.Show("至少要选择一个要导出的表名", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
        Return
    End If
    
    For Each name As String In nms
        dt.Fill("select *,用量 as 理论用量 ,单价 as 理论单价,合价 as 理论合价,报价调整1 as 投标用量,报价调整2 as 投标单价,报价调整3 as 投标合价  from {" & name & "}", True)
        Dim st As New InlineTreeSetting
        st.ParentCol = "科目编码"
        st.ChildCol = "项目构成"
        st.SortCol = "sysgrdtreesort"
        st.AggregateCols = {"合价|报价调整3"}
        st.UseStyle = True
        st.ExpandTo = -1
        dt.ShowGridTree(st)
        dt.Cols("科目编码").Visible = False
        
        Sheet = Book.Sheets.Add(name) '根据勾选表名动态增加工作表
        '定义导出表的表结构代码
        For c As Integer = 0 To lms.length - 1
            Sheet(0, c).Value = lms(c) '指定列标题
            Sheet.Cols(c).Width = szs(c) '指定列宽
        Next
        '定义导出表的数据填充代码(根据列表框勾选,导出的sheet表名也正确,问题就是导出的数据没有根据表名动态导出数据,只导出1个表就是窗口显示的表, 且数据没有折叠功能,没有达到预期功能)
        For r As Integer = 0 To dt.Rows.Count - 1 '填入数据
            Dim rw As Row = dt.rows(r)
            For c As Integer = 0 To lms.length - 1
                If dt.GridTreeVisible Then '如果处于折叠模式
                    If lms(c) = "合价" Then
                        Sheet(r + 1, c).Value = rw.GetValue("合价")
                    ElseIf lms(c) = "项目构成" Then
                        Sheet(r + 1, c).Value = New String(" ", rw.Hierarchy * 2) & rw("项目构成")
                    Else
                        Sheet(r + 1, c).Value = rw(lms(c))
                    End If
                Else
                    Sheet(r + 1, c).Value = rw(lms(c))
                End If
            Next
        Next
    Next
    '打开工作簿
    Book.Save(dlg.FileName)
    Dim Proc As New Process
    Proc.File = dlg.FileName
    Proc.Start()
End If

3楼
刘效功天津 发表于:2025/1/3 11:02:00
好的,谢谢老师,我先试试
共3 条记录, 每页显示 10 条, 页签: [1]

Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号

Powered By Dvbbs Version 8.3.0
Processed in .03711 s, 3 queries.