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 IntegerSub Chapter13()    Strsheetname1 = ActiveSheet.Name '获取当前表的名字    Ilen = Len(Strsheetname1) '获取当前表的长度    Sheets.Add after:=Sheets(Strsheetname1) '新加一个表，放在工资表的后面    '将工资表的名字中的表换为条做为新表的名字    Strsheetname2 = Left(Strsheetname1, Ilen - 1) + "条"    ActiveSheet.Name = Strsheetname2    Chapter13_1 '调用函数Chapter13_1End SubSub Chapter13_1()    '定义Irow取得行数，Icol取得列数Dim i As Integer, Irow As Integer, Icol As Integer    Sheets(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)).Copy    Sheets(Strsheetname2).Select '选择表Strsheetname2    ActiveSheet.Paste '粘贴内容    Range("A1").Select '选择性粘贴列宽    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _        SkipBlanks:=False, Transpose:=False    For i = 2 To Irow - 2        Cells(i * 2, 1).Select  '从第三行开始插入空行行        Selection.EntireRow.Insert '第隔一行插入    Next i    Range(Cells(2, 1), Cells(2, Icol)).Copy '复制表头    For i = 2 To Irow - 2        Cells(i * 2, 1).Select  '选择空行        ActiveSheet.Paste '给空行粘上表头    Next i    Application.CutCopyMode = False '取消当前Clipboard上的内容End Sub