以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  [分享]Excel报表分组分页及各组分页码总页码  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=7695)

--  作者:mr725
--  发布时间:2010/7/26 14:21:00
--  [分享]Excel报表分组分页及各组分页码总页码

大家试一试:

 

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:excel报表分组分页及各组分页码总页码.rar

 

请使用窗口按钮啊/.................

[此贴子已经被作者于2010-7-26 14:34:51编辑过]

--  作者:狐狸爸爸
--  发布时间:2010/7/26 14:51:00
--  
呵呵,辛苦了,给个精华。
--  作者:mr725
--  发布时间:2010/7/26 14:52:00
--  

只是每组的最后一页的页小计和本组合计的位置颠倒了, 狐爸请帮解决一下就好了~


图片点击可在新窗口打开查看此主题相关图片如下:未命名.jpg
图片点击可在新窗口打开查看


--  作者:狐狸爸爸
--  发布时间:2010/7/26 14:54:00
--  
好的,我抽空看看。
--  作者:mr725
--  发布时间:2010/7/26 17:08:00
--  

提醒大家一下: 如果你原有的(如:订单)表已经编辑修改过,那么在按钮代码最前面请加一行保存表的代码做一次保存,否则最有一行代码将会撤销所有修改的~    切记切记啊~·······

 

 


--  作者:czy
--  发布时间:2010/7/26 19:49:00
--  

不错!

只是感觉有些麻烦。

总觉得直接用事件也可以完成的,等以后有空闲时咱试试。


--  作者:mr725
--  发布时间:2010/8/4 14:22:00
--  

1   100801新版后系统可以自动为分组的分页来补空行了,所以代码也不同了:更新如下,请自己放入按钮中吧

2   应用了e-png老弟的强制换行代码, 解决了分页小计在分组合计行的后面的问题(见三楼图那样的尴尬样子)

 

Dim cp As String = DataTables("订单").GetComboListString("产品")
Dim Book As New XLS.Book(ProjectPath & "Attachments\\分组统计1.xls")
Dim Sheet As XLS.Sheet
Sheet = Book.Sheets("sheet1")
Book.Build()
Book.Save(ProjectPath & "reports\\分组统计1.xls")
\'************************************************************************
Dim x,xc,xy,xh As Integer
Dim Book1 As New XLS.Book(ProjectPath & "reports\\分组统计1.xls")
Dim Sheet1 As XLS.Sheet
Sheet1 = Book1.Sheets("sheet1")
For Each c As String In cp.split("|")
    Dim drs As List(Of DataRow)
    drs = DataTables("订单").Select("[产品] = \'" & c & "\'")
    Dim ys1 As Integer = drs.count


    \'************************100801版本后新增::::::::below:
    If ys1 Mod 10 > 0
        ys1 = ys1 + 10-(ys1 Mod 10)
    End If
    \'************************100801版本后新增::::::above:::


    Dim yn As Integer = 10
    For y As Integer = 1 To ys1/10
        x = x + 3
        sheet1(y*yn+x+xc+xh-12+y-1,6).value = c & "第:" & y & " 页"
        sheet1(y*yn+x+xc+xh-12+y-1,7).value = c & "共:" & ys1/10 & " 页"
    Next
    xc = xc +ys1
    xh = xh +1 +ys1/10
Next
Book1.Save(ProjectPath & "reports\\分组统计1.xls")


\'************************100801版本后新增::::below:::强制换行:::::::
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(ProjectPath & "Reports\\分组统计1.xls")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim n As Integer
Dim Rg0 As MSExcel.Range = Ws.UsedRange
For i As Integer = 1 To Rg0.Cells(Rg0.Count).Row+5-1
    If i > n
        If Ws.Cells(i,1).value Like "*合计"
            Dim Rg As MSExcel.Range = Ws.Range("A" & i+1)
            Rg.EntireRow.Insert(MSExcel.XlInsertShiftDirection.xlShiftDown)
            Dim Rg1 As MSExcel.Range = Ws.Range("A" & i & ":" & "H" & i)
            Rg1.Cut(Ws.Range("A" & i+1))
            Rg1 = Ws.Range("A" & i+2 & ":" & "H" & i+2)
            Rg1.Cut(Ws.Range("A" & i))
            Rg1= Ws.Range("A" & i+2)
            Rg1.Entirerow.Delete(MSExcel.XlDirection.xlUp)
            n = i+2
        End If
    End If
Next
Wb.Save
App.quit      \'*********Visible = True  用这个就不要下面的三行代码了,只是打开Excel而已~~
\'************************100801版本后新增::::above:::::

Dim Proc As New Process
Proc.File = ProjectPath & "reports\\分组统计1.xls"
Proc.Start()

 

 

[此贴子已经被作者于2010-8-4 14:23:18编辑过]

--  作者:狐狸爸爸
--  发布时间:2010/8/4 15:22:00
--  
呵呵,多谢了