ExcelVBA工资条制作
工资条的制作,本资源来自于网络,下面我们看一下要求与效果
========代码如下========
Sub 生成工资条()
On Error Resume Next
Dim k As Range, intRow%
Set k = Application.InputBox("请选择工资条的标题行:","请选择", Type:=8)
If k Is Nothing Then Exit Sub
ti = Timer()
k.Cells(1).EntireRow.Insert shift:=xlDown
Set k = k.Offset(-1, 0).EntireRow.Resize(k.Rows.Count 1)
k.Select
intRow = 1
Application.ScreenUpdating = False
With ActiveSheet
Do
k.EntireRow.Copy
.Rows(intRow * (k.Rows.Count 1) k.Cells(1).Row).Insert shift:=xlDown
intRow = intRow 1
Loop While .Cells(intRow * (k.Rows.Count 1) k.Cells(1).Row,k.Column) <> ""
End With
ActiveSheet.Name = "工资条"
Application.CutCopyMode = False
Application.ScreenUpdating = True
Set k = Nothing
MsgBox "工资条制作完成,时间:" &Format(Timer - ti, "00.00秒")
End Sub
=====工作原理=======
这是从开始行插入法:工作原理,先取得工资条的标题--在前面插入一个空行—把这个空行与标题做为一个整体给k—复制k在intRow * (k.Rows.Count 1) k.Cells(1).Row第几k总行 1 k的起始行号处复制插入整体k,---到最后没有数据行为止,
关闭闪屏:代码
Application.ScreenUpdating = False
Application.ScreenUpdating = True
此类型代码一般都是成对出现,一般在过程的开头“禁用”某功能,但在过程的结尾就要“恢复”Excel程序的该项功能。
=====效果图=====