Foxtable(狐表)用户栏目专家坐堂 → [分享]Excel报表分组分页及各组分页码总页码


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

主题:[分享]Excel报表分组分页及各组分页码总页码

帅哥哟,离线,有人找我吗?
mr725
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信 一级勋章
等级:MVP荣誉狐 帖子:5154 积分:31434 威望:0 精华:8 注册:2008/9/8 12:27:00
[分享]Excel报表分组分页及各组分页码总页码  发帖心情 Post By:2010/7/26 14:21:00 [只看该作者]

大家试一试:

 

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

 

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

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

[本帖被加为精华]
 回到顶部
帅哥哟,离线,有人找我吗?
狐狸爸爸
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:管理员 帖子:47497 积分:251403 威望:0 精华:91 注册:2008/6/17 17:14:00
  发帖心情 Post By:2010/7/26 14:51:00 [只看该作者]

呵呵,辛苦了,给个精华。

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


加好友 发短信 一级勋章
等级:MVP荣誉狐 帖子:5154 积分:31434 威望:0 精华:8 注册:2008/9/8 12:27:00
  发帖心情 Post By:2010/7/26 14:52:00 [只看该作者]

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


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


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


加好友 发短信
等级:管理员 帖子:47497 积分:251403 威望:0 精华:91 注册:2008/6/17 17:14:00
  发帖心情 Post By:2010/7/26 14:54:00 [只看该作者]

好的,我抽空看看。

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


加好友 发短信 一级勋章
等级:MVP荣誉狐 帖子:5154 积分:31434 威望:0 精华:8 注册:2008/9/8 12:27:00
  发帖心情 Post By:2010/7/26 17:08:00 [只看该作者]

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

 

 


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


加好友 发短信 一级勋章 三级勋章 二级勋章
等级:超级版主 帖子:6318 积分:33963 威望:0 精华:10 注册:2008/8/31 20:56:00
  发帖心情 Post By:2010/7/26 19:49:00 [只看该作者]

不错!

只是感觉有些麻烦。

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


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


加好友 发短信 一级勋章
等级:MVP荣誉狐 帖子:5154 积分:31434 威望:0 精华:8 注册:2008/9/8 12:27:00
  发帖心情 Post By: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编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
狐狸爸爸
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:管理员 帖子:47497 积分:251403 威望:0 精华:91 注册:2008/6/17 17:14:00
  发帖心情 Post By:2010/8/4 15:22:00 [只看该作者]

呵呵,多谢了

 回到顶部