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

ljxlwq_0803

各位老师好：我套用了论谈上某一老师的代码，“研究”了那位老师上传的”代码“，但还是不太明白。大家能帮我改下代码吗？
我想：
1、把”本页小计“和最后一页的”总计“放在E列（”身份证号码“列），”本页小计“和”总计“字体显示为红色；
2、每张工资表分28行打印；
3、每页小计（总计）列从G（”基本工资‘）列到T（”实发工资‘）列；
4、每页显示表头和表尾的”制表人，备注等“内容
5、单元格能根据单元格大小自动缩小字体；
万分感谢，谢谢！！

ljxlwq_0803

这是2014年那位老师上传的，我同时也在求助于他，但不知道能不能有好消息。谢谢您！

hzruziniu

ljxlwq_0803 发表于 2018-9-30 17:34
这是2014年那位老师上传的，我同时也在求助于他，但不知道能不能有好消息。谢谢您！

1. Sub 插入小计合计()
   
2.     Dim x, y%, r%, a%, b%, i%, n%, j%
   
3.     Worksheets("工资表").Activate
   
4.     x = InputBox("请输入每页拟打印的行数：                   （不能超过一页的范围！！！）")
   
5.     r = Range("a65536").End(3).Row - 1
   
6.     y = WorksheetFunction.RoundUp((r - 5) / x, 0)
   
7.     For i = 1 To y
   
8.         a = (i - 1) * 1 * x + 4 + i
   
9.         If i = y Then
   
10.             b = r + i - 1
    
11.         Else
    
12.             b = a + x - 1
    
13.         End If
    
14.         Rows(b + 1).Insert Shift:=xlDown 'B+1行之上插入一行
    
15.         MsgBox b
    
16.         If i = y Then
    
17.             Rows(b).Copy Rows(b + 1)
    
18.             Rows(b + 1).ClearContents
    
19.         End If
    
20.         Cells(b + 1, 1) = "本页小计"
    
21.         For j = 6 To 20
    
22.             Cells(b + 1, j).Value = Application.WorksheetFunction.Sum(Range(Cells(a, j), Cells(b, j)))
    
23.         Next
    
24.         If i = y Then
    
25.             Rows(b + 2).Insert Shift:=xlDown 'B+2行之上插入一行
    
26.             Rows(b).Copy Rows(b + 2)
    
27.             Rows(b + 2).ClearContents
    
28.             Cells(b + 2, 1) = "总    计"
    
29.             For n = 5 To b + 1
    
30.                 For j = 6 To 20
    
31.                     If Cells(n, 1) = "本页小计" Then
    
32.                         Cells(b + 2, j) = Cells(b + 2, j) + Cells(n, j)
    
33.                     End If
    
34.                 Next
    
35.             Next
    
36.         End If
    
37.      Next
    
38.   End Sub
    
39. 
    
40. Sub 删除小计合计()
    
41.     r = Range("a65536").End(3).Row
    
42.     For i = r To 5 Step -1
    
43.         If Cells(i, 1) = "本页小计" Or Cells(i, 1) = "总    计" Then
    
44.             Rows(i).Delete
    
45.         End If
    
46.     Next
    
47. End Sub

复制代码

hzruziniu

自动分页小计(带总计)2.rar (38.96 KB, 下载次数: 144)

2018-10-2 21:46 上传

点击文件名下载附件

动态设置，每张主表内容可在弹出的消息框中随意输入每张表的行数，小计合计行自动调整。

ljxlwq_0803

收到，谢谢帮助！下载后学习学习。

ljxlwq_0803

hzruziniu 发表于 2018-10-2 21:48
动态设置，每张主表内容可在弹出的消息框中随意输入每张表的行数，小计合计行自动调整。

老师您好：如果我每页打印25行的话，预览时显示是这样的，该如何设置？

hzruziniu

ljxlwq_0803 发表于 2018-10-3 10:09
老师您好：如果我每页打印25行的话，预览时显示是这样的，该如何设置？

你设置的是纵向打印，设置成横向打印，或者用VBA设置打印格式

ljxlwq_0803

hzruziniu 发表于 2018-10-3 10:33
你设置的是纵向打印，设置成横向打印，或者用VBA设置打印格式

老师您好：VBA设置打印格式（横向打印）的代码能帮我一起写进去吗？我是新手，不太懂。万分感谢！！

yaozong

ljxlwq_0803 发表于 2018-10-3 11:15
老师您好：VBA设置打印格式（横向打印）的代码能帮我一起写进去吗？我是新手，不太懂。万分感谢！！

插入人工分页符

Sub 插入小计合计()
    Dim x, y%, r%, a%, b%, i%, n%, j%
    Worksheets("工资表").Activate
    x = InputBox("请输入每页拟打印的行数：                   （不能超过一页的范围！！！）")
    r = Range("a65536").End(3).Row - 1
    y = WorksheetFunction.RoundUp((r - 5) / x, 0)
    For i = 1 To y
        a = (i - 1) * 1 * x + 4 + i
        If i = y Then
            b = r + i - 1
        Else
            b = a + x - 1
        End If
        Rows(b + 1).Insert Shift:=xlDown 'B+1行之上插入一行
        MsgBox b
        If i = y Then
            Rows(b).Copy Rows(b + 1)
            Rows(b + 1).ClearContents
        End If
        Cells(b + 1, 1) = "本页小计"
       ActiveSheet.HPageBreaks.Add Before:=Cells(b + 2, 1) ''插入人工分页符
        For j = 4 To 20
            Cells(b + 1, j).Value = Application.WorksheetFunction.Sum(Range(Cells(a, j), Cells(b, j)))
        Next
        If i = y Then
            Rows(b + 2).Insert Shift:=xlDown 'B+2行之上插入一行
            Rows(b).Copy Rows(b + 2)
            Rows(b + 2).ClearContents
            Cells(b + 2, 1) = "总    计"
            ActiveSheet.HPageBreaks.Add Before:=Cells(b + 3, 1) ''插入人工分页符
            For n = 5 To b + 1
                For j = 4 To 20
                    If Cells(n, 1) = "本页小计" Then
                        Cells(b + 2, j) = Cells(b + 2, j) + Cells(n, j)
                    End If
                Next
            Next
        End If
     Next
  End Sub

Sub 删除小计合计()
    ActiveSheet.ResetAllPageBreaks ''删除人工分页符
    r = Range("a65536").End(3).Row
    For i = r To 5 Step -1
        If Cells(i, 1) = "本页小计" Or Cells(i, 1) = "总    计" Then
            Rows(i).Delete
        End If
    Next
End Sub