楼主
kevinchengcw |
Q: 如何通过vba利用工资表清单生成指定格式的打印表格清单？
A: 代码及注解如下：- Sub test()
- Dim Ws As Worksheet, Arr, Arrt, Arrt2, Result, N&, I&, T%, A%, M, Y%
- M = Application.InputBox("请输入要生成打印表的月份:", "输入", , , , , , 1) '利用inputbox方法输入月份数据(可以控制输入数据类型为数值)
- If M > 0 And M <= 12 Then '如果是有效月份数值,则
- Y = IIf(M = 12, Year(Date) - 1, Year(Date)) '计算对应的年份日期(因工资表一般都是次月打印,故如果为12月工资表则年份应减1)
- On Error GoTo Skip '设置出错跳转
- Application.DisplayAlerts = False '关闭屏幕刷新及警告提示
- Application.ScreenUpdating = False
- For Each Ws In Worksheets '循环各个工作表,如果已存在对应月份的打印表则删除
- If Ws.Name = M & "工资表打印版" Then
- Ws.Delete
- Exit For
- End If
- Next Ws
- With Worksheets(M & "月份工资表")
- If .Cells(.Rows.Count, 1).End(3).Row > 1 Then '如果对应月份工资表有两行以上数据(即扣除标题行后仍有数据),则
- Arr = .Range("a1", .Cells(.Cells(.Rows.Count, 1).End(3).Row, .Cells(1, .Columns.Count).End(1).Column)).Value '将有数据部分提取到数组中
- Arrt = Split("单位,员工号,姓名,职务工资,级别工资,岗位工资,技术等级工资,薪级工资,离退休工资,教育提高部分,教龄,,,,合并补贴,住房补贴,股级,公积金,津贴补贴,供热补贴,劳模补贴,代扣（补）工资,,,,行业补贴,护理费,应发工资,代扣公积金,扣个人所得税,代扣个人医保,实发工资,打印日期", ",") '设定单个工资单的标题数据内容数组
- Arrt2 = Array(2, 1, 2, 2, 2, 3, 2, 4, 2, 5, 2, 6, 2, 7, 2, 8, 2, 9, 2, 10, 2, 11, 4, 4, 4, 5, 4, 6, 4, 7, 4, 8, 4, 9, 4, 10, 4, 11, 6, 4, 6, 5, 6, 6, 6, 7, 6, 8, 6, 9, 6, 10) '设定各个标题对应内容相对于左上角单元格的偏移量对应表数组
- ReDim Result(1 To (UBound(Arr) - 1) * 7, 1 To 11) '重定义结果数组内容为对应数量的表格区域大小
- For N = LBound(Arr) + 1 To UBound(Arr) '循环工资表中除标题行的各行
- I = (N - 1) * 7 - 6 '设定当前行对应的打印表起始单元格行数
- Result(I, 1) = Y & "年" & M & "月份工资表" '设定起始行文本
- For T = LBound(Arrt) To UBound(Arrt) '循环将对应标题写入对应位置
- Result(I + Int(T / 11) * 2 + 1, (T Mod 11) + 1) = Arrt(T)
- Next T
- For T = LBound(Arr, 2) To UBound(Arr, 2) '循环将对应数据定入对应位置
- If (T - 1) * 2 < UBound(Arrt2) Then Result(I + Arrt2((T - 1) * 2), Arrt2((T - 1) * 2 + 1)) = Arr(N, T)
- Next T
- Result(I + 6, 11) = Format(Date, "yyyy年m月d日") '最后写入对应的打印日期
- Next N
- With Worksheets.Add(before:=Worksheets(1)) '添加新的工作表
- .Name = M & "工资表打印版" '命名为对应月份的打印表
- With .Cells '设定单元格水平与垂直方向文字居中对齐,字体大小为12号,行高为21.75
- .HorizontalAlignment = xlCenter
- .VerticalAlignment = xlCenter
- .Font.Size = 12
- .EntireRow.RowHeight = 21.75
- End With
- .[a1].Resize(UBound(Result), UBound(Result, 2)) = Result '将结果数组中的内容写入表格
- For N = 1 To UBound(Arr) - 1 '循环将对应区域格式设置好(合并单元格及设置边框线)
- With .Cells((N - 1) * 7 + 1, 1)
- .Offset(2).Resize(5).Merge
- .Offset(2, 1).Resize(5).Merge
- .Offset(2, 2).Resize(5).Merge
- .Offset(1).Resize(6, 11).Borders.LineStyle = 1
- .Resize(, 11).Merge
- End With
- Next N
- .Columns.AutoFit '设置列宽自适应
- End With
- MsgBox "打印表生成完成" '显示提示信息
- Else '如果月工资表中无有效数据行则显示提示
- MsgBox "该月份工资表中无有效数据行!"
- End If
- End With
- Application.DisplayAlerts = True '恢复屏幕更新及提示信息显示
- Application.ScreenUpdating = True
- ElseIf M = False Then '如果按下了月份输入框的取消按钮则显示此信息
- MsgBox "取消操作"
- Else '其他情况显示月份无效
- MsgBox "无效的月份日期!"
- End If
- Exit Sub '正常完成后由此退出程序
- Skip: '出错时跳转至此,恢复禁止的项目并提示出错
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- MsgBox "出错退出"
- End Sub
详见附件及素材源帖。
 工资表打印wayy.rar
 该帖已经同步到 |