ExcelVBA工资条制作

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程序的该项功能。

=====效果图=====