专家坐堂-分组报表？Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  分组报表？  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=6493)

--  作者：floor2
--  发布时间：2010/4/5 21:57:00
--  分组报表？
要做下面的报表，该用哪种方法比较简单，谢谢

此主题相关图片如下：未命名.bmp

要求:
      根据 “颜色幅宽克重”来分组，同一组的数据依次写入1-15号的表格，若大于15的，则继续写入16-30号，若大于30，写入31-45，
      数据数量少于16的，就在第二列写入第2组的名称，第2组的数据写入到16-30
现在对报表思路一头雾水，请高手帮忙看下，能否提供一些思路，谢谢了。

--  作者：狐狸爸爸
--  发布时间：2010/4/6 8:24:00
--
专业报表，自己写代码。

--  作者：floor2
--  发布时间：2010/4/6 14:53:00
--
悲惨的答案
分组报表和分栏打印如何衔接谢谢

Dim doc As New PrintDoc
Dim rt As New prt.RenderText
Dim ra As New prt.RenderArea
ra.Style.Spacing.Bottom = 2
ra.DataBinding.DataSource = BindTables("订单") \'将容器绑定到订单表
ra.DataBinding.Grouping.Expressions.Add("Fields!产品.Value") \'增加两个分组，分别是产品和雇员
ra.DataBinding.Grouping.Expressions.Add("Fields!雇员.Value") \'
ra.Style.Spacing.Bottom = 2

\'这一个RenderText无需设置DataBinding，这样每一个分组只打印一次
rt.Text= "产品:[Fields!产品.Value] 雇员:[Fields!雇员.Value]"
rt.Style.FontSize = 14
rt.Style.FontBold = True
ra.Children.Add(rt)

\'这一个RenderText需要单独设置DataBinding，这样才会针对每一个数据行打印副本
rt = New prt.RenderText
rt.Text = "日期:[Format(Fields!日期.Value,""yyyy-MM-dd"")] 客户:[Fields!客户.Value] 数量:[Fields!数量.Value]"
rt.DataBinding.DataSource = ra.DataBinding.DataSource \'不能漏掉这一行
ra.Children.Add(rt)
doc.body.Children.Add(ra)
doc.Preview()

打印标签
Dim doc As New PrintDoc \'定义一个报表
Doc.Columns.Add() \'增加三栏
Doc.Columns.Add()
Doc.Columns.Add()
Doc.Columns(0).Spacing = 2 \'栏间距2毫米
Doc.Columns(1).Spacing = 2 \'栏间距2毫米
For i As integer = 1 to 100
    Dim ra As New prt.RenderArea
    Dim rt As prt.RenderText
    ra.Width = "Parent.Width" \'宽度等于分栏宽度
    ra.Height = 24 \'高度24毫米
    ra.CanSplitHorz = False \'禁止水平分割
    ra.CanSplitVert = False \'禁止垂直分割
    ra.Style.Spacing.Bottom = 2
    ra.Style.Borders.All = New prt.Linedef(0.3, Color.Red) \'设置边框
    Doc.Body.ChildRen.Add(ra) \'将容器加入到报表中

    rt = New prt.RenderText
    rt.Text = "姓名："
    rt.X = 2
    rt.Y = 2
    ra.Children.Add(rt) \'添加到容器中

    rt = New prt.RenderText
    rt.Text = "黄财德"
    rt.X = 15
    rt.Y = 2
    ra.Children.Add(rt)

    rt = New prt.RenderText
    rt.Text = "职务："
    rt.X = 2
    rt.Y = "Prev.Bottom + 2" \'垂直坐标位于迁移对象之下的2毫米
    ra.Children.Add(rt)

    rt = New prt.RenderText
    rt.Text = "总经理"
    rt.X = 15
    rt.Y = "Prev.Top" \'垂直坐标和前一对象相同
    ra.Children.Add(rt)

    rt = New prt.RenderText
    rt.Text = "编号："
    rt.X = 2
    rt.Y = "Prev.Bottom + 2"
    ra.Children.Add(rt)

    rt = New prt.RenderText
    rt.Text = "44081919710917243"
    rt.X = 15
    rt.Y = "Prev.Top"
    ra.Children.Add(rt)
Next
Doc.Preview() \'预览报表

Dim doc As New PrintDoc
Dim rt As Prt.RenderTable
Dim rx As prt.RenderText
Dim tbl As Table = Tables("发货清单明细")
Dim Rows As List(Of DataRow)
Dim Regions As List(Of String()) = tbl.DataTable.GetUniqueValues("","客户","颜色","幅宽")
doc.Pagesetting.LandScape = True
For Each Region As String() In Regions

    rx = New prt.RenderText
    rx.Text = "客户: " & Region(0) & "," & region(1) & "," & region(2)
    doc.Body.Children.Add(rx)
    rt = New prt.RenderTable
    rt.Style.Font = Tables("发货清单明细").Font
    rt.Style.Font = tbl.Font
                                \'"[品名] = \'" & dr1("品名") & "\'And [规格] = \'" & dr1("规格") & "\'"
    Rows = tbl.Datatable.Select("[客户] = \'" & Region(0) & "\'and [颜色] = \'" & Region(1) & "\'and [幅宽] = \'" & Region(2) & "\'")
    For c As integer = 0 To tbl.Cols.Count - 1
        rt.Cells(0,c).Text = tbl.Cols(c).Name
        rt.Cols(c).Width = tbl.Cols(c).PrintWidth
        For r As integer = 0 To Rows.Count -1
            rt.Cells(r + 1, c).Text = rows(r)(tbl.Cols(c).Name)
        Next
    Next
    rt.RowGroups(0,1).Header = prt.TableHeaderEnum.All
    doc.Body.Children.Add(rt)
Next
doc.preview()

[此贴子已经被作者于2010-4-6 17:32:05编辑过]

--  作者：狐狸爸爸
--  发布时间：2010/4/6 15:00:00
--
用表格，而不是分栏

--  作者：floor2
--  发布时间：2010/4/6 23:21:00
--
Dim doc As New PrintDoc
Dim rt As Prt.RenderTable
Dim rx As prt.RenderText
Dim re As prt.RenderText
Dim tbl As Table = Tables("订单")
Dim Rows As List(Of DataRow)
Dim Regions As List(Of String()) = tbl.DataTable.GetUniqueValues("","客户","产品","雇员")
doc.Pagesetting.LandScape = True
For Each Region As String() In Regions

    rx = New prt.RenderText
    rx.Text = "客户: " & Region(0) & "," & region(1) & "," & region(2)
    rx.Style.FontBold = True
    rx.Style.Spacing.Bottom = 3
    doc.Body.Children.Add(rx)

re = New prt.RenderText
re.Text= "合计:[Aggregates!GroupSum.Value]"
    re.Style.FontBold = True
    re.Style.Spacing.Bottom = 3
    doc.Body.Children.Add(re)

    rt = New prt.RenderTable
    rt.Style.GridLines.All = New prt.Linedef
    rt.Cols.Count = 10
    rt.Style.Font = Tables("订单").Font
    rt.Style.Font = tbl.Font
    Rows = tbl.Datatable.Select("[客户] = \'" & Region(0) & "\'and [产品] = \'" & Region(1) & "\'and [雇员] = \'" & Region(2) & "\'")

    Dim ColNames As String() = New String(){"数量"}
    For r As integer = 0 To Rows.Count -1 \'开始填入该列内容
        select case r
            case 0
                rt.Cells(0, r).Text = Rows(r)(ColNames(0))
            case 1 to 9
                rt.Cells(0, r).Text = Rows(r)(ColNames(0))
                rt.Style.Spacing.All = 1
            case 10 to 19
                rt.Cells(1, r-10).Text = Rows(r)(ColNames(0))
            case 20 to 29
                rt.Cells(2, r-20).Text = Rows(r)(ColNames(0))
            case 30 to 39
                rt.Cells(3, r-30).Text = Rows(r)(ColNames(0))
            case 40 to 49
                rt.Cells(4, r-40).Text = Rows(r)(ColNames(0))
            case 50 to 59
                rt.Cells(5, r-50).Text = Rows(r)(ColNames(0))
            case 60 to 69
                rt.Cells(6, r-60).Text = Rows(r)(ColNames(0))
            case 70 to 79
                rt.Cells(7, r-70).Text = Rows(r)(ColNames(0))
        end select
    Next

    rt.RowGroups(0,1).Header = prt.TableHeaderEnum.All
    doc.Body.Children.Add(rt)
Next
doc.preview()

基本上搞定，应该可以代替部分分栏效果，就是合计如何放在右侧上方，与客户并列，一个在左，一个在右？

Dim doc As New PrintDoc
Dim rt As Prt.RenderTable
Dim rx As prt.RenderText
Dim re As prt.RenderText
Dim re1 As prt.RenderText
Dim tbl As Table = Tables("发货清单明细")
Dim Rows As List(Of DataRow)
Dim Regions As List(Of String()) = tbl.DataTable.GetUniqueValues("","颜色","颜色编号","幅宽","克重","单价") \'"卷长","金额")
Dim Regi As List(Of String) = tbl.DataTable.GetUniqueValues("","客户")
Dim Regio As List(Of String) = tbl.DataTable.GetUniqueValues("","发货日期")
doc.Pagesetting.LandScape = True
dim sum1 as single=0
dim sum3 as single=0
dim sum2 as single=0
dim count as short=0
re = New prt.RenderText
re.Text= "发货结算单"
\'re.Style.FontBold = True
\'re.Style.Spacing.Bottom = 3
re.Style.FontSize = 16
re.Style.TextAlignHorz = prt.AlignHorzEnum.Center \'水平居中
doc.Body.Children.Add(re)
Dim rx1 As New prt.RenderTable
rx1.Cells(0,0).Text = "客户:" & regi(0)
rx1.Cells(0,1).Text = "发货日期:" & regio(0).SubString(0,9)
rx1.Cells(0,2).Text = "货单号:                      ."
rx1.Cols(0).Style.TextAlignHorz = prt.AlignHorzEnum.Left
rx1.Cols(1).Style.TextAlignHorz = prt.AlignHorzEnum.Center
rx1.Cols(1).Style.TextAlignHorz = prt.AlignHorzEnum.right
rx1.Style.Borders.Bottom = New prt.LineDef (0.3, color.gray)\'设置底边框
rx1.CellStyle.Spacing.Bottom = 0.5 \'底端内容缩进0.5毫米
\'rx1.Style.FontSize = 8 \'字体大小为8磅
rx1.Style.Spacing.top = 2
\'Doc.PageHeader = rx1
doc.Body.Children.Add(rx1)
\'dim f As integer=0
Dim rf As new Prt.RenderTable
rf.Style.TextAlignHorz = prt.AlignHorzEnum.center

rf.Cols(0).Width = 8
rf.Cols(1).Width = 32
rf.Cols(2).Width = 30
rf.Cols(3).Width = 14
rf.Cols(4).Width = 20
rf.Cols(5).Width = 14
rf.Cols(6).Width = 20
rf.Cols(7).Width = 14
rf.width="auto"
rf.cells(0,0).text="编号"
rf.cells(0,1).text="颜色编号"
rf.cells(0,2).text="规格"
rf.cells(0,3).text="件数"
rf.cells(0,4).text="重量"
rf.cells(0,5).text="单价"
rf.cells(0,6).text="金额"
rf.cells(0,7).text="备注"
doc.Body.Children.Add(rf)
dim f As integer=0
For Each Region As String() In Regions
    dim sum as single=0
    \'dim f As integer=0

    rt = New prt.RenderTable
    \'rt.Style.GridLines.All = New prt.Linedef(0.1, color.gray)
    \'rt.Cols.Count = 15
    \'rt.style.WordWrap=true
    \'rt.Style.TextAlignHorz = prt.AlignHorzEnum.Center
    Rows = tbl.Datatable.Select("[颜色] = \'" & Region(0) & "\'and [颜色编号] = \'" & Region(1) & "\'and [幅宽] = \'" & Region(2) & "\'and [克重] = \'" & region(3) & "\'and [单价] = \'" & region(4) & "\'")
    Dim ColNames As String() = New String(){"重量"}
    For r As integer = 0 To Rows.Count -1 \'开始填入该列内容
        count=0
        select case r
            case 0
                rt.Cells(0, r).Text = Rows(r)(ColNames(0))
                sum=sum+Rows(r)(ColNames(0))
                count=1
            case 1 to 14
                rt.Cells(0, r).Text = Rows(r)(ColNames(0))
                sum=sum+Rows(r)(ColNames(0))
            case 15 to 29
                rt.Cells(1, r-15).Text = Rows(r)(ColNames(0))
                sum=sum+Rows(r)(ColNames(0))
                count=count+1
            case 30 to 44
                rt.Cells(2, r-30).Text = Rows(r)(ColNames(0))

                sum=sum+Rows(r)(ColNames(0))
                count=count+1
            case 45 to 59
                rt.Cells(3, r-45).Text = Rows(r)(ColNames(0))
                sum=sum+Rows(r)(ColNames(0))
                count=count+1
            case 60 to 74
                rt.Cells(4, r-60).Text = Rows(r)(ColNames(0))
                sum=sum+Rows(r)(ColNames(0))
                count=count+1
            case 75 to 89
                rt.Cells(5, r-75).Text = Rows(r)(ColNames(0))
                sum=sum+Rows(r)(ColNames(0))
                count=count+1
        end select

        \'rt.Cells(0,10).SpanRows = count

    next
    sum=sum*0.976
    rf = New prt.RenderTable

    rf.Style.TextAlignHorz = prt.AlignHorzEnum.center
    rf.Style.GridLines.All = New prt.Linedef(0.1, color.gray)
    \'rf.height=8

    rf.cols(0).style.fontsize = 12 \'设置行高
    rf.Cols(0).Width = 8
    rf.Cols(1).Width = 32
    rf.Cols(2).Width = 30
    rf.Cols(3).Width = 14
    rf.Cols(4).Width = 20
    rf.Cols(5).Width = 14
    rf.Cols(6).Width = 20
    rf.Cols(7).Width = 14
    rf.width="auto"
    rf.cells(f+1,1).text=region(0) & "," & region(1)
    rf.cells(f+1,2).text=region(2) & "*" & region(3) & "g*2222m"
    rf.cells(f+1,3).text=rows.count & "件"
    rf.cells(f+1,4).text=math.round(sum,2) & "kg"
    rf.cells(f+1,5).text=region(4)
    rf.cells(f+1,6).text=Tables("发货清单明细").DataTable.Compute("Sum(金额)","[颜色] = \'" & Region(0) & "\'and [颜色编号] = \'" & Region(1) & "\'and [幅宽] = \'" & Region(2) & "\'and [克重] = \'" & region(3) & "\'and [单价] = \'" & region(4) & "\'")
    rf.cells(f+1,0).text=f+1
f=f+1
    doc.Body.Children.Add(rf)

    \' rt.RowGroups(0,1).Header = prt.TableHeaderEnum.All
    \'doc.Body.Children.Add(rt)
    \'next
    sum1=sum1+sum
    sum2=sum2+Rows.Count
sum3=sum3+Tables("发货清单明细").DataTable.Compute("Sum(金额)","[颜色] = \'" & Region(0) & "\'and [颜色编号] = \'" & Region(1) & "\'and [幅宽] = \'" & Region(2) & "\'and [克重] = \'" & region(3) & "\'")

next
re1 = New prt.RenderText
re1.Text= "总重量:" & sum1 & "公斤       总件数" & sum2 & "件"
re1.Style.Spacing.top = 5
re1.Style.FontSize = 12
doc.Body.Children.Add(re1)
rx = New prt.RenderText
      rx.Text = "金额: " & sum3 \'Tables("发货清单明细").DataTable.Compute("Sum(金额)","[颜色] = \'" & Region(0) & "\'and [颜色编号] = \'" & Region(1) & "\'and [幅宽] = \'" & Region(2) & "\'and [克重] = \'" & region(3) & "\'")
\'Region(0) & "," & region(1) & "," & region(2) & "," & region(3) & "   重量:" & sum & " 件数" & Rows.Count
    rx.Style.FontBold = True
     rx.Style.Spacing.top = 3
    doc.Body.Children.Add(rx)

doc.PageSetting.Width = 175 \'纸张宽度为100毫米
doc.PageSetting.Height = 255 \'纸张高度为120毫米
Doc.PageSetting.LeftMargin = 10 \'设置左边距
Doc.PageSetting.RightMargin = 10 \'设置右边距
Doc.PageSetting.TopMargin = 20 \'设置上边距
Doc.PageSetting.BottomMargin = 20 \'设置下边距
doc.preview()

[此贴子已经被作者于2010-4-8 0:10:36编辑过]

--  作者：程兴刚
--  发布时间：2010/4/6 23:55:00
--

写入客户的同时向那一行的右侧制定单元格写入合计！

我研究过比这更复杂的专业报表，感觉很爽，研究明白了就不觉得复杂了：
（这算是比较复杂的报表，注：接头统计数与实际不符，是手工胡乱输入的，为了测试，统计代码没问题）

此主题相关图片如下：123_page1.png

同时，还可以给专业报表制作复杂的专业设置界面，实现更加灵活的任意格式专业报表：

此主题相关图片如下：124.jpg