Foxtable(狐表)用户栏目专家坐堂 → 专业报表按组分页


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

主题:专业报表按组分页

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


加好友 发短信
等级:幼狐 帖子:136 积分:1427 威望:0 精华:0 注册:2013/8/7 18:14:00
专业报表按组分页  发帖心情 Post By:2023/8/11 16:12:00 [只看该作者]

老师,以下代码如何修改才能按销售代号分组分页生成(即同一个销售代号在同一页,每页分两栏,每栏固定25行,自动添加空行)

Dim ReportDate As String =Format( e.Form.Controls("EndDate2").Value ,"yyyy年MM月")  '定义开始日期
Dim st As Date = Date.Now

'EXCEl报表_父表数据
Dim Book As New XLS.Book(ProjectPath & "Attachments\应收账款校准表.xls")
Book.Build() '生成细节区
Dim lj As String = ProjectPath & "" & ReportDate & "报表\" & ReportDate & "应收账款校准表.xls" '定义保存路径及文件名
Book.Save(lj) '保存工作簿

''应付账款
'excel模板应设置页面宽度\高度为自动,如设置为1页,则分页无效
'分栏分页
'EXCEL_VBA_明细表数据



Dim tb As Table = Tables("应收账款明细表")
tb.Filter="金额<>0"
Dim nms() As String = {"客户名称","金额","回款率","销售代号"}

Dim prs As Integer = 25 '每页细节区行数
Dim fl As Integer = 2 '每页栏数
Dim ls As Integer = 7 '每栏列数
Dim bts As Integer = 1 '表头数
Dim bws As Integer = 0 '表尾数

Dim csh As Integer  '每页初始行
Dim s,g,lz,zh As Integer
zh=prs+bts+bws  '每页总行数


Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(lj)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
App.ScreenUpdating = False 
For p As Integer = 1 To math.Ceiling(tb.Rows.Count /( fl*prs)) - 1  'p分页
    Ws.Rows("1:" & zh).Copy(Ws.Range("a" & p*zh+1))
Next

Ws.Cells.PageBreak = MSExcel.XlPageBreak.xlPageBreakNone'清除所有分页符
Ws.Columns(fl*ls+1).PageBreak = MSExcel.XlPageBreak.xlPageBreakManual '纵向分页

For p As Integer = 0 To math.Ceiling(tb.Rows.Count /( fl*prs)) - 1  'p分页
    csh=bts+p*zh
    s = 0
    g = 1
    
    For r As Integer =  P*FL*prs To math.min(tb.Rows.Count - 1,( p + 1) *fl* prs - 1)  '在每页数据内循环
        
        lz = (Int(s/prs)) * ls+1  '指定数据列数
        If s/prs = Int((s+1)/prs)  Then g = 1     
        ws.cells(csh+g,lz) = r+1
        
        For m As Integer = 0 To nms.Length-1
            ws.cells(csh+g,lz+m+1) = tb.rows(r)(nms(m))
        Next
        g = g + 1 '每页每列各数据累计次数
        s = s + 1 '每页各数据累计次数
        
    Next
    'msgbox((p+1)*zh+1)
    Ws.Rows((p+1)*zh+1).PageBreak = MSExcel.XlPageBreak.xlPageBreakManual
Next

Ws.PageSetup.CenterHeader = ""
MessageBox.Show("耗时: " & (Date.Now - st).TotalSeconds & "秒") '计算并显示执行代码所花费的秒数
Wb.Save
App.ScreenUpdating = True
App.Visible = True

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


加好友 发短信
等级:超级版主 帖子:111393 积分:567029 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2023/8/11 16:20:00 [只看该作者]

请上传实例测试

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


加好友 发短信
等级:幼狐 帖子:136 积分:1427 威望:0 精华:0 注册:2013/8/7 18:14:00
  发帖心情 Post By:2023/8/11 16:42:00 [只看该作者]

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目1.rar
代码放在窗口按钮里

想要下面图片这种效果

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


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


加好友 发短信
等级:超级版主 帖子:111393 积分:567029 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2023/8/11 17:25:00 [只看该作者]

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目1.zip


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


加好友 发短信
等级:幼狐 帖子:136 积分:1427 威望:0 精华:0 注册:2013/8/7 18:14:00
  发帖心情 Post By:2023/8/13 9:59:00 [只看该作者]

老师是要按销售代号进行分组分页,一页两栏25行只打印同个销售代号的内容,没内容自动留空
原先的代码实现了一页两栏25行没内容自动留空,但不知道怎么实现按销售代号进行分页分组
[此贴子已经被作者于2023/8/13 10:09:04编辑过]

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


加好友 发短信
等级:超级版主 帖子:111393 积分:567029 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2023/8/13 20:07:00 [只看该作者]


 回到顶部