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 = Strsheetname2
    Chapter13_1 '调用函数Chapter13_1
End Sub
Sub 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