求助：EXCEL工资表用VBA代码自动生成“本页小计”，“总计”

ljxlwq_0803

hzruziniu 发表于 2018-10-3 16:02
这个是2007，我没有2010系统

老师您好：不明白是什么原因了，2007和2003打印预览是一样的。

ljxlwq_0803

hzruziniu 发表于 2018-10-3 16:02
这个是2007，我没有2010系统

老师您好：点图7的打印图标后，能正常显示每页25行，但不能显示全部页，图8是序号1-25，图6是序号76-100，页脚每页都是1/1，要第1页打印后才能打印第2页，不能一次性打印1-N页吗？谢谢！

yaozong

ljxlwq_0803 发表于 2018-10-3 13:40
老师您好：我是新手中新手，代码不太明白，您能不能帮我把这代码“整理”下，谢谢！！

参考附件
根据打印页数据行行数设定，行高自动调整。

ljxlwq_0803

yaozong 发表于 2018-10-3 20:44
参考附件
根据打印页数据行行数设定，行高自动调整。

收到，谢谢老师！谢谢！！

ljxlwq_0803

yaozong 发表于 2018-10-3 20:44
参考附件
根据打印页数据行行数设定，行高自动调整。

老师您好：再有一个不情之请，如最后一页数据只有若干行，“本页小计”和“合计”直接显示在“最后一行”后面，这个要加什么代码？也就是说最后一页没达到整页时，实际有几行显示几行，“总计”行后以空白显示。图9中“本页小计”行前3行不显示。谢谢！

yaozong

ljxlwq_0803 发表于 2018-10-3 21:41
老师您好：再有一个不情之请，如最后一页数据只有若干行，“本页小计”和“合计”直接显示在“最后一行” ...

Sub 生成每页定行打印稿3() ''页尾插入指定行/自动调整行高
  Sheets("工资表").Activate
  If Cells(Rows.Count, 1).End(3) = "合计" Then Exit Sub
  'ActiveSheet.ResetAllPageBreaks
  Dim arr, ar, a&, c&, f&, i&, j&, k&, m&, r&, ps, h#, p, y, k1
  arr = [a1].CurrentRegion.Value
  ar = [{6,7,8,9,10,11,13,14,15,16,18,19,20}] ''每页小计的列（列号)
  r = UBound(arr): c = UBound(arr, 2)
  a = 4 ''顶端标题行行数
  f = 1 ''尾端合计行行数（如只插入小计1行）
  ActiveSheet.PageSetup.PrintTitleRows = "$1:$" & a
  k = InputBox("请输入每页行数（不包括标题行和本页小计行）：", "打印页行数设定", 25) ''默认为当前页行数
  m = r - a '数据行行数
  p = Int(m / k)
  y = m - p * k
  Cells(r + 1, 1) = "本页小计"
    Cells(r + 1, 1).Resize(1, 5).HorizontalAlignment = xlCenterAcrossSelection
    For j = 1 To UBound(ar)
      Cells(r + 1, ar(j)).FormulaR1C1 = "=SUBTOTAL(109,R[-" & y & "]C:R[-1]C)"
    Next
  Cells(r + 2, 1) = "合计"
    Cells(r + 2, 1).Resize(1, 5).HorizontalAlignment = xlCenterAcrossSelection
    For j = 1 To UBound(ar)
      Cells(r + 2, ar(j)).FormulaR1C1 = "=SUBTOTAL(109,R5C:R[-1]C)"
    Next
  Cells(r + 1, 1).Resize(2, c).Borders.LineStyle = 1
  For i = r - y + 1 To a + 2 Step -k
    Rows(i).EntireRow.Insert
    Cells(i, 1) = "本页小计"
    Cells(i, 1).Resize(1, 5).HorizontalAlignment = xlCenterAcrossSelection
    For j = 1 To UBound(ar)
      Cells(i, ar(j)).FormulaR1C1 = "=SUBTOTAL(109,R[-" & k & "]C:R[-1]C)"
    Next
  Next
  h = Rows(a + 1).RowHeight
  ActiveSheet.Cells.RowHeight = h ''统一表格行高
  ps = ActiveWindow.SelectedSheets.HPageBreaks(1).Location.Row - 1
  k1 = ps - a - f ''每页数据行（行数）
  ActiveSheet.Cells.RowHeight = Application.Round(((k1 + a + 1) * h) / (k + a + 1), 2)
End Sub

Sub 撤销每页定行打印稿3() ''恢复原数据结构
  Sheets("工资表").Activate
  Application.ScreenUpdating = False
  Dim r&, i&
  r = Cells(Rows.Count, 1).End(3).Row
  For i = r To 5 Step -1
    If Cells(i, 1) = "本页小计" Or Cells(i, 1) = "合计" Then
      Rows(i).EntireRow.Delete
    End If
  Next
  ActiveSheet.ResetAllPageBreaks
  Application.ScreenUpdating = True
End Sub

yaozong

ljxlwq_0803 发表于 2018-10-3 21:41
老师您好：再有一个不情之请，如最后一页数据只有若干行，“本页小计”和“合计”直接显示在“最后一行” ...

要审核，直接上附件了。

ljxlwq_0803

收到，非常感谢

ggmmlol

不使用VBA，通过技巧方法，可以轻松添加本页小计和总——请见我的主题帖：
【技巧分享】怎样在每一页末添加“本页小计”和“累计”并自动分页？
http://club.excelhome.net/thread-1415264-1-1.html

ljxlwq_0803

ggmmlol 发表于 2018-10-4 13:32
不使用VBA，通过技巧方法，可以轻松添加本页小计和总——请见我的主题帖：
【技巧分享】怎样在每一页末添 ...

收到，谢谢