主题：专业报表代码请老师指导下

代码如下:

Dim doc As New PrintDoc '定义一个报表
Dim rt As New prt.RenderTable() '定义一个表格对象
Dim rx As New prt.RenderText '定义一个文本对象
Dim tb As Table = Tables("表A")
doc.AutoRotate = False '禁止自动旋转打印内容
doc.PageSetting.Landscape = True '横向打印
doc.PageSetting.PaperKind = 9 '纸张类型改为B5
Doc.PageSetting.LeftMargin = 14 '设置左边距
Doc.PageSetting.RightMargin = 1 '设置右边距
Doc.PageSetting.TopMargin = 3 '设置上边距
Doc.PageSetting.BottomMargin = 3 '设置下边距
Dim prs As Integer = 23 '每页20行
Dim sum1 As Integer = 0 '数量小计
Dim sum2 As Double = 0 '金额小计
Dim tsum1 As Integer = 0 '数量总计
Dim tsum2 As Double = 0 '金额总计
Dim idx1 As Integer= tb.cols("借方发生额").Index
Dim idx2 As Integer= tb.cols("贷方发生额").Index

For p As Integer = 0 To math.Ceiling(tb.Rows.Count / prs) - 1
    sum1 = 0
    sum2 = 0
    rt = New prt.RenderTable
    rt.Rows.Count = 25 '设置总行数
    rt.Cols.Count = 25 '设置总列数
    rt.Height = 204 '设置表格的高度为80毫米
    rt.Width = 280
    rt.Rows(0).Height = 8 '设置第7行
    rt.Rows(1).Height = 8 '设置第7行高度
    rt.Cols(0).Width = 35
    rt.Cols(1).Width = 50
    rt.Cols(23).Width = 35
    rt.Cols(24).Width = 35
   
    '设置合并单元格
    rt.Cells(0,0).SpanRows = 2 '第1行第5个单元格向下合并2行
    rt.Cells(0,12).SpanRows = 25 '第1行第5个单元格向下合并2行
    rt.Cells(0,1).SpanRows = 2 '第1行第5个单元格向下合并2行
    rt.Cells(0,23).SpanRows = 2 '第1行第5个单元格向下合并2行
    rt.Cells(0,24).SpanRows = 2 '第1行第5个单元格向下合并2行
    rt.Cells(0,2).SpanCols = 10 '第1行第2个单元格向右合并10列
    rt.Cells(0,13).SpanCols = 10 '第1行第2个单元格向右合并10列
   
    '设置表格样式
    rt.Style.FontSize = 13
    rt.Rows(0).Style.FontSize = 14 '字体大小为16磅
    rt.Rows(1).Style.FontSize = 12 '字体大小为16磅
    rt.Style.FontBold = True '字体加粗
    rt.Cells(0,0).Text = "日    期"
    rt.Cells(0,1).Text = "摘             要"
    rt.Rows(0).Style.TextAlignHorz = prt.AlignHorzEnum.Center
    rt.Rows(1).Style.TextAlignHorz = prt.AlignHorzEnum.Center
    rt.Cells(0,2).Text = "借方发生额"
    rt.Cells(0,13).Text = "贷方发生额"
    rt.Cells(0,23).Text = "汇款银行"
    rt.Cells(0,24).Text = "款项来源"
    rt.Cells(1,2).Text = "千"
    rt.Cells(1,3).Text = "百"
    rt.Cells(1,4).Text = "十"
    rt.Cells(1,5).Text = "万"
    rt.Cells(1,6).Text = "千"
    rt.Cells(1,7).Text = "百"
    rt.Cells(1,8).Text = "十"
    rt.Cells(1,9).Text = "元"
    rt.Cells(1,10).Text = "角"
    rt.Cells(1,11).Text = "分"
   
    rt.Cells(1,13).Text = "千"
    rt.Cells(1,14).Text = "百"
    rt.Cells(1,15).Text = "十"
    rt.Cells(1,16).Text = "万"
    rt.Cells(1,17).Text = "千"
    rt.Cells(1,18).Text = "百"
    rt.Cells(1,19).Text = "十"
    rt.Cells(1,20).Text = "元"
    rt.Cells(1,21).Text = "角"
    rt.Cells(1,22).Text = "分"
   
    rt.Style.GridLines.All = New prt.Linedef '设置网格线
    rt.Style.TextAlignVert = prt.AlignVertEnum.Center '内容垂直居中
    rt.Style.TextAlignHorz = prt.AlignHorzEnum.Center '内容水平居中
    '下面很简单,指定每一个单元格的内容
    For t As Integer = p * prs To math.min(tb.Rows.Count - 1,( p + 1) * prs - 1)
        sum1 =sum1 + tb.rows(t)("借方发生额")
        sum2 =sum2 + tb.rows(t)("贷方发生额")
        For r As Integer = 0 To tb.Rows.Count - 1 '遍历关联表每一行
            If tb.rows(r)("日期") <> #01/01/0001# Then
                rt.Cells(r+2,0).Text = Format(tb.rows(r)("日期"),"yyyy年MM月dd日")
                rt.Cells(r+2,1).Text = tb.rows(r)("摘要")
                Dim money As Integer = tb.rows(r)("借方发生额")
                If money > 0 Then
                    For i As Double = 9 To 2 Step - 1
                        rt.Cells(r+2, i).Text = GetDigit(Money,9-i)
                        If rt.Cells(r+2, i).Text =  "￥" Then
                            Exit For
                        End If
                    Next
                    money = (tb.rows(r)("借方发生额") - money) * 100
                    If money > 0 Then
                        rt.Cells(r+2, 11).Text = GetDigit(Money,0)
                    Else
                        rt.Cells(r+2, 11).Text = 0
                    End If
                    If money > 10 Then
                        rt.Cells(r+2, 10).Text = GetDigit(Money,1)
                    Else
                        rt.Cells(r+2, 10).Text = 0
                    End If
                End If
                Dim money1 As Integer = tb.rows(r)("贷方发生额")
                If money1 > 0 Then
                    For i As Double = 20 To 13 Step - 1
                        rt.Cells(r+2, i).Text = GetDigit(Money1,20-i)
                        If rt.Cells(r+2, i).Text =  "￥" Then
                            Exit For
                        End If
                    Next
                    money1 = (tb.rows(r)("贷方发生额") - money1) * 100
                    If money1 > 0 Then
                        rt.Cells(r+2, 22).Text = GetDigit(Money1,0)
                    Else
                        rt.Cells(r+2, 22).Text = 0
                    End If
                    If money1 > 10 Then
                        rt.Cells(r+2, 21).Text = GetDigit(Money1,1)
                    Else
                        rt.Cells(r+2, 21).Text = 0
                    End If
                End If
                rt.Cells(r+2,23).Text = tb.rows(r)("汇款银行")
                rt.Cells(r+2,24).Text = tb.rows(r)("款项来源")
            End If
        Next
    Next
    tsum1 = tsum1 + sum1
    tsum2 = tsum2 + sum2
    rt.Rows.Count = rt.Rows.Count + 1 '增加本页小计行
    rt.Rows(rt.Rows.count -1)(0).text = "本页小计"
    Dim jf As Integer = sum1
    If jf > 0 Then
        For i As Double = 9 To 2 Step - 1
            rt.Rows(rt.Rows.count -1)(11).text = GetDigit(jf,9-i)
            If rt.Rows(rt.Rows.count -1)(2,11).text =  "￥" Then
                Exit For
            End If
        Next
        jf = (sum1 - jf) * 100
        If jf > 0 Then
            rt.Rows(rt.Rows.count -1)(2,11).text = GetDigit(jf,0)
        End If
   End If
        'rt.Rows(rt.Rows.count -1)(idx1).text = sum1
        'rt.Rows(rt.Rows.count -1)(idx2).text = sum2
        If p = math.Ceiling(tb.Rows.Count / prs) - 1 '如果是最后一页
            rt.Rows.Count = rt.Rows.Count + 1 '增加总计行
            rt.Rows(rt.Rows.count -1)(0).text = "总计"
            rt.Rows(rt.Rows.count -1)(1).text = tsum1
            rt.Rows(rt.Rows.count -1)(24).text = tsum2
        Else
            rt.BreakAfter = prt.BreakEnum.Page '否则换页
        End If
        doc.Body.Children.Add(rt) '将表格对象加入到报表中
    Next
    Doc.Preview() '预览报表

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:管理项目12.zip

想要做出帮助文件中"分页汇总"效果,分页代码如下:

Dim doc As New PrintDoc
Dim tb As Table = Tables("订单")
Dim prs As Integer = 20 '每页20行
Dim sum1 As Integer = 0 '数量小计
Dim sum2 As Double = 0 '金额小计
Dim tsum1 As Integer = 0 '数量总计
Dim tsum2 As Double = 0 '金额总计
Dim idx1 As Integer= tb.cols("数量").Index
Dim idx2 As Integer= tb.cols("金额").Index
For p As Integer = 0 To math.Ceiling(tb.Rows.Count / prs) - 1
    Dim rt As New prt.RenderTable
    rt.Style.Gridlines.All = New prt.Linedef(Color.Gray)
    rt.CellStyle.Spacing.All = 0.5
    sum1 = 0
    sum2 = 0
    For c As Integer = 0 To tb.Cols.Count - 1
        rt.Cells(0,c).Text = tb.Cols(c).Name
    Next
    For r As Integer = p * prs To math.min(tb.Rows.Count - 1,( p + 1) * prs - 1)
        sum1 =sum1 + tb.rows(r)("数量")
        sum2 =sum2 + tb.rows(r)("金额")
        For c As Integer = 0 To tb.Cols.Count - 1
            rt.Cells(r - p * prs + 1, c).Text = tb.rows(r)(c)
        Next
    Next
    tsum1 = tsum1 + sum1
    tsum2 = tsum2 + sum2
    rt.Rows.Count = rt.Rows.Count + 1 '增加本页小计行
    rt.Rows(rt.Rows.count -1)(0).text = "本页小计"
    rt.Rows(rt.Rows.count -1)(idx1).text = sum1
    rt.Rows(rt.Rows.count -1)(idx2).text = sum2
    If p = math.Ceiling(tb.Rows.Count / prs) - 1 '如果是最后一页
        rt.Rows.Count = rt.Rows.Count + 1 '增加总计行
        rt.Rows(rt.Rows.count -1)(0).text = "总计"
        rt.Rows(rt.Rows.count -1)(3).text = tsum1
        rt.Rows(rt.Rows.count -1)(6).text = tsum2
    Else
        rt.BreakAfter = prt.BreakEnum.Page '否则换页
    End If
    doc.Body.Children.Add(rt)
Next
doc.Preview()

今天老师都陪孩子过节日去了

你是想这样吗?

.

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:管理项目12.foxdb

感谢Bin老师,原来是循环代码没做清楚,再请教下老师,这里面只达到了一半的效果,当数据大于23行时,第二页的数据跟第一页一样,比如要打印的数据为1000行,代码再怎么修改让数据按每页20行排列下去,再连续打印?

图1是第一页效果,图2是第二页效果,数据重复了
此主题相关图片如下：图1.png


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

还有角跟分的数位怎么排进去,一直尝试不行

 

If jf > 0 Then
            rt.Rows(rt.Rows.count -1)(2).text = GetDigit(jf,0)
        Else
            rt.Rows(rt.Rows.count -1)(2).text = 0
        End If
        If jf > 10 Then
            rt.Rows(rt.Rows.count -1)(1).text = GetDigit(jf,1)
        Else
            rt.Rows(rt.Rows.count -1)(1).text = 0
        End If

角分的代码已经解决,代码如下

Dim jf As Integer = sum1
    If jf > 0 Then
        For i As Double = 9 To 2 Step - 1
            rt.Rows(rt.Rows.count -1)(i).text = GetDigit(jf,9-i)
            If rt.Rows(rt.Rows.count -1)(i).text =  "￥" Then
                Exit For
            End If
        Next
        jf = (sum1 - jf) * 100
        If jf > 0 Then
            rt.Rows(rt.Rows.count -1)(11).text = GetDigit(jf,0)
        Else
            rt.Rows(rt.Rows.count -1)(11).text = 0
        End If
        If jf > 10 Then
            rt.Rows(rt.Rows.count -1)(10).text = GetDigit(jf,1)
        Else
            rt.Rows(rt.Rows.count -1)(10).text = 0
        End If
    End If

   最后当中的代码改成这样,就差内容重复了,请教下老师代码再怎么修改

 For t As Integer = p * prs To math.min(tb.Rows.Count - 1,( p + 1) * prs - 1)
        sum1 =sum1 + tb.rows(t)("借方发生额")
        sum2 =sum2 + tb.rows(t)("贷方发生额")
        For r As Integer = 0 To tb.Cols.Count - 1 '遍历关联表每一行
            If tb.rows(r)("日期") <> #01/01/0001# Then
                rt.Cells(r+2,0).Text = Format(tb.rows(r)("日期"),"yyyy年MM月dd日")
                rt.Cells(r+2,1).Text = tb.rows(r)("摘要")
                Dim money As Integer = tb.rows(r)("借方发生额")
                If money > 0 Then
                    For i As Double = 9 To 2 Step - 1
                        rt.Cells(r+2, i).Text = GetDigit(Money,9-i)
                        If rt.Cells(r+2,i).Text =  "￥" Then
                            Exit For
                        End If
                    Next
                    money = (tb.rows(r)("借方发生额") - money) * 100
                    If money > 0 Then
                        rt.Cells(r+2, 11).Text = GetDigit(Money,0)
                    Else
                        rt.Cells(r+2, 11).Text = 0
                    End If
                    If money > 10 Then
                        rt.Cells(r+2, 10).Text = GetDigit(Money,1)
                    Else
                        rt.Cells(r+2, 10).Text = 0
                    End If
                End If
                Dim money1 As Integer = tb.rows(r)("贷方发生额")
                If money1 > 0 Then
                    For i As Double = 20 To 13 Step - 1
                        rt.Cells(r+2, i).Text = GetDigit(Money1,20-i)
                        If rt.Cells(r+2, i).Text =  "￥" Then
                            Exit For
                        End If
                    Next
                    money1 = (tb.rows(r)("贷方发生额") - money1) * 100
                    If money1 > 0 Then
                        rt.Cells(r+2, 22).Text = GetDigit(Money1,0)
                    Else
                        rt.Cells(r+2, 22).Text = 0
                    End If
                    If money1 > 10 Then
                        rt.Cells(r+2, 21).Text = GetDigit(Money1,1)
                    Else
                        rt.Cells(r+2, 21).Text = 0
                    End If
                End If
                rt.Cells(r+2,23).Text = tb.rows(r)("汇款银行")
                rt.Cells(r+2,24).Text = tb.rows(r)("款项来源")
            End If
        Next
    Next
    tsum1 = tsum1 + sum1
    tsum2 = tsum2 + sum2
    rt.Rows.Count = rt.Rows.Count + 1 '增加本页小计行
    rt.Rows(rt.Rows.count -1)(0).text = "本页小计"
    Dim jf As Integer = sum1
    If jf > 0 Then
        For i As Double = 9 To 2 Step - 1
            rt.Rows(rt.Rows.count -1)(i).text = GetDigit(jf,9-i)
            If rt.Rows(rt.Rows.count -1)(i).text =  "￥" Then
                Exit For
            End If
        Next
        jf = (sum1 - jf) * 100
        If jf > 0 Then
            rt.Rows(rt.Rows.count -1)(11).text = GetDigit(jf,0)
        Else
            rt.Rows(rt.Rows.count -1)(11).text = 0
        End If
        If jf > 10 Then
            rt.Rows(rt.Rows.count -1)(10).text = GetDigit(jf,1)
        Else
            rt.Rows(rt.Rows.count -1)(10).text = 0
        End If
    End If
    Dim df As Integer = sum2
    If df > 0 Then
        For i As Double = 20 To 13 Step - 1
            rt.Rows(rt.Rows.count -1)(i).text = GetDigit(df,20-i)
            If rt.Rows(rt.Rows.count -1)(i).text =  "￥" Then
                Exit For
            End If
        Next
        df = (sum2 - df) * 100
        If df > 0 Then
            rt.Rows(rt.Rows.count -1)(22).text = GetDigit(df,0)
        Else
            rt.Rows(rt.Rows.count -1)(22).text = 0
        End If
        If df > 10 Then
            rt.Rows(rt.Rows.count -1)(21).text = GetDigit(df,1)
        Else
            rt.Rows(rt.Rows.count -1)(21).text = 0
        End If
    End If
    If p = math.Ceiling(tb.Rows.Count / prs) - 1 '如果是最后一页
        rt.Rows.Count = rt.Rows.Count + 1 '增加总计行
        rt.Rows(rt.Rows.count -1)(0).text = "总计"
        Dim zjf As Integer = tsum1
        If zjf > 0 Then
            For i As Double = 9 To 2 Step - 1
                rt.Rows(rt.Rows.count -1)(i).text = GetDigit(zjf,9-i)
                If rt.Rows(rt.Rows.count -1)(i).text =  "￥" Then
                    Exit For
                End If
            Next
            zjf = (tsum1 - zjf) * 100
            If zjf > 0 Then
                rt.Rows(rt.Rows.count -1)(11).text = GetDigit(zjf,0)
            Else
                rt.Rows(rt.Rows.count -1)(11).text = 0
            End If
            If zjf > 10 Then
                rt.Rows(rt.Rows.count -1)(10).text = GetDigit(zjf,1)
            Else
                rt.Rows(rt.Rows.count -1)(10).text = 0
            End If
        End If
        Dim zdf As Integer = tsum2
        If zdf > 0 Then
            For i As Double = 20 To 13 Step - 1
                rt.Rows(rt.Rows.count -1)(i).text = GetDigit(zdf,20-i)
                If rt.Rows(rt.Rows.count -1)(i).text =  "￥" Then
                    Exit For
                End If
            Next
            zdf = (tsum2 - zdf) * 100
            If zdf > 0 Then
                rt.Rows(rt.Rows.count -1)(22).text = GetDigit(zdf,0)
            Else
                rt.Rows(rt.Rows.count -1)(22).text = 0
            End If
            If zdf > 10 Then
                rt.Rows(rt.Rows.count -1)(21).text = GetDigit(zdf,1)
            Else
                rt.Rows(rt.Rows.count -1)(21).text = 0
            End If
        End If
    Else
        rt.BreakAfter = prt.BreakEnum.Page '否则换页
    End If
    doc.Body.Children.Add(rt) '将表格对象加入到报表中
Next