Excel VBA高效办公应用-第十三章-工资条与工资查询-Part1 （制作工资条）

同样，在如今的互联网时代，以下的工资条处理方式看上去太陈旧了。不过，十多年前，我自己还真领过这种格式的纸质工资条。哎呀，又暴露年龄了

Option Explicit
'定义全局变量Sid,Sname,Sxueli以便于各个块都能访问
'Sid表示员工号码,Sname表示员工姓名,Sxueli表示员工学历
Public Sid As String, Sname As String, Sxueli As String
'Icidao表示迟到的次数,Ikuang旷工的尽数,Ijiaban加班的次数,Itai销售台数
Public Icidao As Integer, Ikuang As Integer, Ijiaban As Integer, Itai As Integer

Option Explicit'定义变量Strsheetname1获取当前表的名字，Ilen来获取长度
Dim Strsheetname1 As String, Strsheetname2 As String, Ilen As Integer
Sub Chapter13()Strsheetname1 = ActiveSheet.Name '获取当前表的名字Ilen = Len(Strsheetname1) '获取当前表的长度Sheets.Add after:=Sheets(Strsheetname1) '新加一个表，放在工资表的后面'将工资表的名字中的表换为条做为新表的名字Strsheetname2 = Left(Strsheetname1, Ilen - 1) + "条"ActiveSheet.Name = Strsheetname2Chapter13_1 '调用函数Chapter13_1
End Sub
Sub Chapter13_1()'定义Irow取得行数，Icol取得列数
Dim i As Integer, Irow As Integer, Icol As IntegerSheets(Strsheetname1).Activate '激活Strsheetname1表'取得行数Irow = Sheets(Strsheetname1).[A1].CurrentRegion.Rows.Count'取得列数Icol = Sheets(Strsheetname1).[A1].CurrentRegion.Columns.Count'将Strsheetname1表内内容复制Range(Cells(1, 1), Cells(Irow, Icol)).CopySheets(Strsheetname2).Select '选择表Strsheetname2ActiveSheet.Paste '粘贴内容Range("A1").Select '选择性粘贴列宽Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _SkipBlanks:=False, Transpose:=FalseFor i = 2 To Irow - 2Cells(i * 2, 1).Select  '从第三行开始插入空行行Selection.EntireRow.Insert '第隔一行插入Next iRange(Cells(2, 1), Cells(2, Icol)).Copy '复制表头For i = 2 To Irow - 2Cells(i * 2, 1).Select  '选择空行ActiveSheet.Paste '给空行粘上表头Next iApplication.CutCopyMode = False '取消当前Clipboard上的内容
End Sub