人事资料管理

来源:互联网 发布:淘宝怎么没有换货申请 编辑:程序博客网 时间:2024/04/19 01:17

人事资料管理

 

此段文字节选自《Excel VBA范例大全》一书

【系统适用范围】小型企业。

【系统内容说明】本人事资料管理系统具有以下功能:

— 专业的密码登录界面;

— 公司简介及程序说明;

— 用窗体录入员工资料;

— 身份证号及工号重复提示;

— 厂牌打印;

— 工资表计算、年资计算、个人所得税计算;

— 制作工资条;

— 随意透视各部门工资。

【界面设计与系统结构】

1)建立工作簿架构

 新建工作簿,再建立三个表。

 分别将三个表重命名为“厂牌打印”、“人事资料”和“工资表”。

 按照本公司厂牌样式设计一个厂牌打印区,如图17.11所示。

 单击菜单【开发工具】/【插入】/【表单控件】,单击里面的“按钮”控件,在厂牌区域旁边绘出一个按钮,然后以同样方式绘制一个列表框(ActiveX控件),如图17.12所示。

 在人事资料表A1中输入“人事资料表”,A2:J2中分别输入“姓名”、“性别”、“籍贯”、“学历”、“民族”、“语种”、“身份证”、“工号”、“职务”、“地址”,其明细资料将从窗体中导入。

 “工资表”按照公司要求格式录入表头和明细资料,其中“年资”项根据公司规定用公式计算。本例中假设“未满半年无年资、半年到一年者50、一年时100、以后每满一年加50、上限为300”,则所用公式如下:

=LOOKUP(MONTH(TODAY())-MONTH(G3)+(YEAR(TODAY())-YEAR(G3))*12,{0,6,12,24,36,48,60},{0,50,100,150,200,250,300})

 “工资表”中“个人所得税”项目计算公式如下:

=INT(SUM((I3-1600>{0,500,2000,5000,20000,40000,60000,80000,100000})*(I3-1600

=-{0,500,2000,5000,20000,40000,60000,80000,100000}))*0.05)

此公式为数组公式,输入完毕后需要同时按Ctrl+Shift+Enter组合键完成。

2)设计登录窗体

 使用快捷键Alt+F11进入VBEVisual Basic Editor)环境。

 单击菜单【插入】/【窗体】,按F4快捷键显示属性窗口,在属性窗口中将“名称”改为“登录”,将“Caption”改为“权限验证”,其中密码框的“PasswordChar”属性需要设置为*,以避免在输入密码时明文显示。

 在窗体中绘制两个标签、两个文本框和一个按钮,并按图17.13所示方式命名(其余图片可以根据各自喜好设置)。

3)设计资料录入主界面

 单击菜单【插入】/【窗体】,在属性窗口中将“名称”改为“人事资料管理”,将“Caption”改为“人事资料管理”。

 单击工具箱中的“多页”控件,在窗体中绘制一个“多页控件”,将第一页的“Caption”和“ControlTiptext”分别命名为“公司简介”,将第二页的“Caption”和“ControlTiptext”分别命名为“输入人事资料”。

 用绘图工具设计一幅背景图,通过修改“Picture”属性将之设置为多页控件的背景。

 在第一页绘制一个空网页,网页内容为公司简介,通过程序代码生成。

 在底端可嵌入一个横条形Flash动画作为装饰。首页整体界面如图17.14所示。

 第二页为人事资料录入界面。需要绘制10个标签、10个文本框、4个按钮,命名及控件布局如图17.15所示。

【关键技术运用】本系统主要有以下几个方面的技术运用:

— 登录框权限验证;

— 网页滚动式公司简介,支持鼠标移过事件;

— 通过窗体录入数据;

— 检测录入资料的重复性并提示;

— 文本框的自动定位:包括每录完一笔资料时定位第一个录入框,以及某项目出现重复错误时光标自动定位于该项录入框中;

— 有制作和删除工资条专用菜单;

— 控制菜单的可用性:在指定页面中可操作,否则菜单呈灰色禁用状态。

【程序代码分析】

1)系统初始化及生成菜单代码

初始化代码,存于ThisWorkbook代码窗口中(用于建立与控制菜单、显示登录框):

Private Sub Workbook_Open()   '开启工作簿时发生

    Application.EnableCancelKey = xlDisabled  '禁止中断执行

    Application.Visible = False               '程序不可见

    生成工资条菜单                            '生成菜单

    登录.Show                                 '菜单登录框

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Application.Visible = True                '关闭工作簿时程序可见

    Application.CommandBars(1).Controls("工资条专用(&P)").Delete  '删除菜单

    Application.EnableCancelKey = xlInterrupt              '恢复中断模式

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object) '激活工作表时发生此事件

    Dim i As Byte

    For i = 1 To 3    '如果当前表是“工资表”,则前三个子菜单可见,否则不可见

        Application.CommandBars(1).Controls("工资条专用(&P)")

        .Controls(i).Enabled = (ActiveSheet.Name = "工资表")

    Next i

End Sub

生成菜单及子菜单所对应的程序:

Sub 生成工资条菜单()

    Dim Menu As CommandBarControl, SubMenu As CommandBarControl

    Set SubMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, 1, , 8, 1)

    '生成一个下拉菜单

    SubMenu.Caption = "工资条专用(&P)"

    With SubMenu.Controls.Add(msoControlButton, 1, , , True) '生成子菜单

        .Caption = "生成工资条(&C)"

        .OnAction = "生成工资条"

        .Style = msoButtonIconAndCaption

        .FaceId = 137

    End With

    With SubMenu.Controls.Add(msoControlButton, 1, , , True)

        .Caption = "删除工资条(&D)"

        .OnAction = "删除工资条"

        .Style = msoButtonIconAndCaption

        .FaceId = 138

    End With

    With SubMenu.Controls.Add(msoControlButton, 1, , , True)

        .Caption = "按部门透视工资表(&A)"

        .OnAction = "建立透视表"

        .Style = msoButtonIconAndCaption

        .FaceId = 481

    End With

    With SubMenu.Controls.Add(msoControlButton, 1, , , True)

        .Caption = "返回资料输入窗口(&R)"

        .OnAction = "返回窗体"

        .Style = msoButtonIconAndCaption

        .FaceId = 484

    End With

End Sub

Sub 生成工资条()

    Application.ScreenUpdating = False

    Dim cell As Range, YRng As Range, Xrng As Range, RowNum As Integer, i As Integer

    If ActiveSheet.ProtectContents Then MsgBox "工作表已保护,本程序拒绝执

    行!", 64, "提示": Exit Sub    '如果保存了工作表则不执行程序

    Set cell = Cells(3, 2)  '设定变量为C2单元格

    Do                      '开始循环

        cell.Offset(1, 0).Rows("1:3").EntireRow.Insert Shift:=xlDown

        '在单元格后插入三行

        Set cell = cell.End(xlDown)   

        '重新设定变量cell的地址:当前单元格向下第一个非空单元格

        RowNum = ActiveSheet.UsedRange.Rows.Count  '记录当前表已用区域行数

    Loop While cell.Row < RowNum                 

    '程序循环执行直到当前单元格向下第一个非空单元格的行号大于当前表已用区域行数

    RowNum = ActiveSheet.UsedRange.Rows.Count    '记录当前表已用区域行数

    Rows("1:2").Select                        '选择两行标题行

    Selection.Copy                            '复制标题行

    Set YRng = Rows("5:6")

    For i = 9 To RowNum Step 4

        Set YRng = Union(YRng, Rows(i & ":" & i + 1))  '组合需要复制标题的行

    Next

    YRng.Select                                        '选中该区域

    ActiveSheet.Paste                                  '粘贴

    Set Xrng = Rows(4)

    For i = 8 To RowNum Step 4

        Set Xrng = Union(Xrng, Rows(i))                '组合所有空行

    Next

    Xrng.Select                                        '选择空行

    Selection.Borders.LineStyle = xlNone               '去除空行的网格线

    Application.ScreenUpdating = True

End Sub

Sub 删除工资条()

    Dim cell As Range, RowNum As Integer, i As Integer, down

    Set cell = Rows("4:6")

    RowNum = Range("B1048576").End(xlUp).Row  '记录B列最后一个非空行的行号

    For i = 8 To RowNum Step 4

        Set cell = Union(cell, Range("B" & i).Rows("1:3").EntireRow) 

        '组合标题行及空行(不包括第一个标题行)

    Next

    Application.ScreenUpdating = False

    cell.Select                          '选择区域

    Selection.Delete Shift:=xlUp         '删除

    Application.ScreenUpdating = True

End Sub

Sub 建立透视表()

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=

    Application.Intersect(ActiveSheet.UsedRange, ActiveSheet.UsedRange

    .Offset(1, 1))) .CreatePivotTable TableDestination:="",

    TableName:="按部门查看"  '选择数据源

    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(1, 1)

    '透视表存放位置

    With ActiveSheet.PivotTables("按部门查看").PivotFields("姓名")

        .Orientation = xlRowField

        .Position = 1

    End With

    With ActiveSheet.PivotTables("按部门查看").PivotFields("部门")

        .Orientation = xlPageField

        .Position = 1

    End With

    ActiveSheet.PivotTables("按部门查看").AddDataField ActiveSheet.PivotTables

        ("按部门查看").PivotFields("工资"), "求和项:工资", xlSum

    ActiveSheet.Move after:=Sheets(Sheets.Count)

    ActiveSheet.Name = "透视工资表"

End Sub

Sub 返回窗体()

    Application.Visible = False

    人事资料.Show

End Sub

2)登录框代码

Private Sub CommandButton1_Click()

    Static i  '声明一个非静态变量

    If TextBox1.Text = "" Then MsgBox "用户名不能为空!": Exit Sub 

     '未输入用户名则退出程序

    If i = 3 Then                                  '如果错误三次

        MsgBox "你已尝试三次错误,程序即将关闭!"    '提示

        Unload Me                                    '关闭窗体

        Application.Visible = True                '恢复程序可见

        ThisWorkbook.Close False                  '关闭工作簿且不保存

        Exit Sub                                     '退出程序

    End If

    '只能andy/sky/andysky三个指定用户名可以登录

    If (TextBox1.Text = "andy" Or TextBox1.Text = "sky" Or TextBox1.Text=

        "andysky") And TextBox1.Text <> "" Then

        If TextBox2.Text <> "admin" Then       '如果密码不是admin

            MsgBox "密码不符,请重新输入!"          '提示

            i = i + 1                              '累加变量,记录错误次数

            Exit Sub                               '退出程序

        Else                                        '否则

            i = 0                                   '恢复计数器为0

            Unload Me                              '关闭窗体

            MsgBox TextBox1.Text & ":你好" & Chr(10) & "欢迎进入系统!",

             vbOKOnly, "登录成功"    '问候

            人事资料.Show                          '显示资料录入窗体

        End If

    Else

        MsgBox "用户名不符,请重新输入!", 64, "警告"   '用户名不对则退出

    End If

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If CloseMode <> 1 Then Cancel = True          '不允许关闭窗体

End Sub

3)资料录入窗体代码

滚动的公司简介代码如下(鼠标移过时文字将停止滚动):

Const Wt1 = " document.write ("""

Const Wt2 = """)"

Const D1 = "<p style='line-height: 150%; margin-top: 0; margin-bottom: 0'>"

Private Sub UserForm_Activate()

    Me.MultiPage1.Value = 0

    WebBrowser1.Navigate "about:blank"   '初始化空白网页

    With Me.ShockwaveFlash1                '调整Flash长宽高

        .Height = 54

        .Width = 414

        .Top = 252

    End With

    Do While WebBrowser1.Busy

        DoEvents

    Loop

    With Me.WebBrowser1.Document

        .Open

        .WriteLn "<style TYPE=" & Chr(34) & "text/css" & Chr(34) & ">"

        .WriteLn "<!--"

        .WriteLn "A:link{text-decoration:none}"

        .WriteLn "A:visited{text-decoration:none}"

        .WriteLn "A:hover {color: #00FF00;text-decoration:underline}"

        .WriteLn "body {background-color: #3399FF}"             '设置背景色

        .WriteLn "-->"

        .WriteLn "</style>"

        .WriteLn "<BODY scroll=" & VBA.Chr(34) & "no" & VBA.Chr(34) & _

                 "onselectstart=event.returnValue=false " & _

                 "oncontextmenu=window.event.returnValue=false " & _

                 ">"

        .WriteLn "<content=" & Chr(34) & "text/html; charset=big5" & Chr(34) & ">"

        .WriteLn "<TABLE cellSpacing=0 cellPadding=0 border=0>"

        .WriteLn "<SCRIPT language=JavaScript>"    

        '以下设置文字滚动速度和方向及宽度/高度,help.stop表示鼠标移过时停止滚动

        .WriteLn Wt1 & "<marquee scrollamount='1' scrolldelay='30' direction=

        'UP' width='250' id='help' height='300' onmouseover='help.stop()'

        onmouseout='help.start()'>" & Chr(34) & ")"

        .WriteLn Wt1 & "<Font style='filter:glow(color=##FF8000,

         strength=2); height: 1px; padding: 1px'>" & Wt2

        '以下是网页正文

        .WriteLn Wt1 & "设计者:<a href='mailto:andy_qc@163.com'

         target='_blank'>罗刚君 andysky</a> " & Wt2

        .WriteLn Wt1 & "<P></P>" & Wt2

        .WriteLn Wt1 & "</font>" & Wt2

        .WriteLn Wt1 & "<Font Size=3>" & Wt2

        .WriteLn Wt1 & "<Br color=#00FF00 >" & Wt2

        .WriteLn Wt1 & "<HR>" & "<P></P>" & Wt2

        .WriteLn Wt1 & "四维公司简介" & "<P></P>" & Wt2

        .WriteLn Wt1 & "四维实业公司成立于1988" & "<P></P>" & Wt2

        .WriteLn Wt1 & "由董事长罗四维注册建厂" & "<P></P>" & Wt2

        .WriteLn Wt1 & "公司拥有厂房N栋、宿舍M" & "<P></P>" & Wt2

        .WriteLn Wt1 & "占地面积8888平方米" & "<P></P>" & Wt2

        .WriteLn Wt1 & "注册资金:666万人民币" & "<P></P>" & Wt2

        .WriteLn Wt1 & "主产电脑主板和内存" & "<P></P>" & Wt2

        .WriteLn Wt1 & "年产量主板20万块,内存30万条" & "<P></P>" & Wt2

        .WriteLn Wt1 & "物品出口额达每年5000万元" & "<P></P>" & Wt2

        .WriteLn Wt1 & "本公司以诚信为本" & "<P></P>" & Wt2

        .WriteLn Wt1 & "质量第一  顾客至上" & "<P></P>" & Wt2

        .WriteLn Wt1 & "产品获ISO 9002质量体系认证" & "<P></P>" & Wt2

        .WriteLn Wt1 & "公司环境符合ISO 14000认证" & "<P></P>" & Wt2

        .WriteLn Wt1 & "绝对值得你信任" & "<P></P>" & Wt2

        .WriteLn Wt1 & "<hr>" & "<P></P>" & Wt2

        .WriteLn Wt1 & "本公司双休制" & "<P></P>" & Wt2

        .WriteLn Wt1 & "周一至周五营业" & "<P></P>" & Wt2

        .WriteLn Wt1 & "欢迎随时来电恰谈业务" & "<P></P>" & Wt2

        .WriteLn Wt1 & "将由前台专人接待" & "<P></P>" & Wt2

        .WriteLn Wt1 & "本公司电话:" & "<P></P>" & Wt2

        .WriteLn Wt1 & "85868788" & "<P></P>" & Wt2

        .WriteLn Wt1 & "本公司传真:" & "<P></P>" & Wt2

        .WriteLn Wt1 & "88878685" & "<P></P>" & Wt2

        .WriteLn Wt1 & "<HR>" & "<P></P>" & Wt2

        .WriteLn Wt1 & "以上纯属虚构!" & "<P></P>" & Wt2

        .WriteLn Wt1 & D1 & "联系人:<a href='mailto:andy_qc@163.com'>

         andy_qc@163.com</a></p>" & Wt2

        .WriteLn Wt1 & "</Font>" & Wt2

        .WriteLn Wt1 & "</Marquee>" & Wt2

        .WriteLn "</SCRIPT>"

    End With

    WebBrowser1.Refresh2

End Sub

为了不让窗口通过右上角关闭按钮关闭,加入以下代码:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If CloseMode <> 1 Then Cancel = True          '不允许关闭窗体

End Sub

第二页“输入人事资料”,为了让按钮突出鼠标移过特效,使用“MouseMove”事件对按钮和按钮文字进行设置:

Private Sub MultiPage1_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Dim i As Byte   '鼠标移过多页控件时发生此事件

    For i = 1 To 4

        With Me.Controls("CommandButton" & i)  '分别对四个按钮进行设置

            .Font.Italic = False                 '加粗字体

            .Font.Size = 10                      '加大字号

            .BackColor = &H8000000F              '修改按钮颜色

        End With

    Next i

End Sub

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    With CommandButton1

        .Font.Italic = True

        .Font.Size = 12

        .BackColor = &HFFC0C0

        .MousePointer = fmMousePointerHelp

    End With

End Sub

Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    With CommandButton2

        .Font.Italic = True

        .Font.Size = 12

        .BackColor = &HFFC0C0

        .MousePointer = fmMousePointerHelp

    End With

End Sub

Private Sub CommandButton3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    With CommandButton3

        .Font.Italic = True

        .Font.Size = 12

        .BackColor = &HFFC0C0

        .MousePointer = fmMousePointerHelp

    End With

End Sub

Private Sub CommandButton4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    With CommandButton4

        .Font.Italic = True

        .Font.Size = 12

        .BackColor = &HFFC0C0

        .MousePointer = fmMousePointerHelp

    End With

End Sub

“输入人事资料”页第一个按钮“新增档案”代码:

Private Sub CommandButton1_Click()    '单击新增按钮时执行

    Dim a As Byte, b As Long, c

    If Me.TextBox1 = "" Then MsgBox "请输入姓名!": TextBox1.SetFocus: Exit Sub

    '未输入姓名则退出程序

    If Me.TextBox7 = "" Then MsgBox "请输入身份证号!": TextBox7.SetFocus:

    Exit Sub    '未输入身份证号则退出程序

    If Me.TextBox8 = "" Then MsgBox "请为新员分配工号!": TextBox8.SetFocus:

    Exit Sub  '未输入工号则退出程序

    b = ThisWorkbook.Sheets("人事资料").Range("a65536").End(xlUp).Row + 1

    '求出A列第一个空行行号

    If WorksheetFunction.CountIf(Sheets("人事资料").Range("G3:G" & b), TextBox7) = 0 Then  '如果输入的身份证号码未与工作表中G列数据重复

        If WorksheetFunction.CountIf(Sheets("人事资料").Range("H3:H" & b), TextBox8) <> 0 Then    '如果输入的工号与工作表中H列数据重复

            MsgBox "已存在该工号,请重新分配一个工号", 32, "友情提示"     '那么提示数据重复

            TextBox8.SetFocus                 '激活输入工号的文本框

            Exit Sub                          '退出程序

        Else                                  '否则

            For a = 1 To 10                 '10个录入的数据逐个加入到工作表中

                ThisWorkbook.Sheets("人事资料").Cells(b, a) = Me.Controls ("textbox" & a)

                Me.Controls("textbox" & a) = ""               '清除控件值

            Next a

        End If

    Else

        MsgBox "表中已存在此身份证号码,请核对后再输入。", 32, "友情提示"

        '如果录入的身份证号与G列数据重复

        TextBox7.SetFocus                '激活输入身份证的文本框

        Exit Sub

    End If

    TextBox1.SetFocus                '激活输入姓名的文本框

End Sub

第二个按钮“打印厂牌”代码:

Private Sub CommandButton2_Click()   '单击打印厂牌按钮时执行

    Application.Visible = True

    ThisWorkbook.Sheets("厂牌打印").Select

    Unload Me

End Sub

第三个按钮“工资表”代码:

Private Sub CommandButton4_Click()    '单击工资表按钮时执行

    Application.Visible = True

    ThisWorkbook.Sheets("工资表").Select

    Unload Me

End Sub

第四个按钮“退出程序”代码:

Private Sub CommandButton3_Click()  '单击退出按钮时执行

    Application.Quit

End Sub

4)“厂牌打印”工作表中按钮代码和单击列表框的代码(第一个程序为“姓名为”按钮对应的宏程序;第二个为单击列表框时更新厂牌打印区的引用数据)

Sub 姓名()   '当人事资料更新后用此程序更新列表框内容

    Dim a

    a = WorksheetFunction.CountA(Sheets("人事资料").Columns("A:A"))   

    '记录“人事资料”表数据个数

    ActiveWorkbook.Names.Add Name:="姓名", RefersToR1C1:="=人事资料!

    R3C1:R" & a & "C3"    '添加名称

    With Me.ListBox1

        .ListFillRange = "姓名"   '将名称所引用的数据加入到列表框中

        .ColumnHeads = True       '让列表框显示表头

        .ColumnCount = 3          '显示三列

        .ColumnWidths = "50,50,50"    '设置列宽

        .BackColor = &HFFC0C0      '设置颜色

        .ListStyle = fmListStyleOption  '设置样式

    End With

End Sub

Private Sub ListBox1_Change()    '单击列表框时执行

    On Error Resume Next

    Range("c4") = ListBox1.Value   'C4单元格等于列表框的值

    '到人事资料表中已用区域查找列表框的值,若找到则取其所在行第8列和第9列的值

    Range("c6") = WorksheetFunction.VLookup(ListBox1.Value, Sheets

("人事资料").Range("a2").CurrentRegion, 8, 0)

    Range("c8") = WorksheetFunction.VLookup(ListBox1.Value, Sheets

("人事资料").Range("a2").CurrentRegion, 9, 0)

End Sub

【效果演示】

启动人事资料管理工作簿。

程序弹出验证对话框,同时隐藏工作簿界面。若直接单击“确定”按钮,系统将弹出警告如图17.16所示;若输入用户名不是“andy”、“sky”或者“andysky”,则系统弹出警告如图17.17所示。

若用户名正确,但输入密码非“admin”,则系统弹出提示如图17.18所示;若连续三次输入错误,则系统弹出提示如图17.19所示,单击“确定”按钮后Excel即立即关闭。

如果用鼠标单击窗体右上角红色关闭按钮,可以发现程序已将之锁定,没有任何反应;用快捷键Alt+F4仍然如此,开启工作簿必须输入正确的密码。

当输入正确的用户名和密码后,登录窗口关闭,同时系统弹出欢迎窗口,提示如图17.20所示。

单击“确定”按钮后,出现“人事资料管理”主窗口,其首页的公司简介反复地从下向上滚动,当鼠标移过时则停止滚动,移到旁边则继续滚动;单击公司简介中的邮件地址,程序将启动Outlook,如图17.21所示。

单击第二页“输入人事资料”,鼠标移过任意按钮时,按钮变色显示,同时字体加大、倾斜以突显选项,如图17.22所示。

直接单击“新增档案”按钮,程序弹出提示“请输入姓名!”,如图17.23所示。

在第一个文本框中输入姓名后,按回车键,光标自动定位于第二个文本框“性别”框中,依此类推,输入所有信息都只需要按回车键,不需要单击鼠标。当最后光标定位于“新增档案”按钮上时,按回车键,程序将所有信息导出到工作表中,同时清空所有文本框信息,光标自动定位于第一个文本框等待输入下一笔资料。

第二笔资料中在“身份证”框录入与前资料相同的号码,当单击“新增档案”按钮时,程序将弹出已存在该身份证号码的提示,如图17.24所示。同时光标定位于身份证号码输入框,等待重新输入。

 将身份证号码修改为与前一笔资料不重复,但输入与前一笔资料同样的工号,单击“新增档案”按钮,将弹出工号重复的提示,如图17.25所示。

 不输入工号即单击“新增档案”按钮,程序将提示“请为新员工分配工号”的提示,如图17.26所示。

 单击“打印厂牌”按钮,输入人事资料窗口立即关闭,进入“厂牌打印”工作表。

 单击“调用人事资料”按钮,空列表框立即列举出人事资料表中所有资料,如图17.27所示;单击列表框中的“向问天”条目,则厂牌打印区立即调用向问天的资料,如图17.28所示。

 测试利用工资表生成工资条及透视表功能。因为当前表是“厂牌打印”表,禁止使用工资条相关代码,故单击菜单【加载项】/【工资条专用】,“生成工资条”、“删除工资条”和“按部门透视工资表”三个菜单都禁用,如图17.29所示。

 进入“工资表”,再次单击菜单【加载项】/【工资条专用】,则菜单已可用,如图17.30所示。

  单击菜单【加载项】/【工资条专用】/【生成工资条】,工资表立即生成工资条样式,中间有一个空行方便裁剪,如图17.31所示。

 单击菜单【加载项】/【工资条专用】/【删除工资条】,工资条立即复原,如图17.32所示。

 单击菜单【加载项】/【工资条专用】/【按部门透视工资表】,程序立即新建一个工作表置于当前表之后,并以工资表数据建立数据透视表。透视表可以随意调整,查看任意单个或者多个部门的数据,如图17.33所示为仅仅查看厂务、车间、总务之数据。

 可以调整透视表的页字段,使之显示任意数据,如图17.34所示。

 不能在生成工资条状态下建立透视表,否则会出错。当然,也可以在生成透视表的代码中加入判断语句,如果目前“工资表”中数据以工资条形式存在则退出程序。此语句很简单,留给读者思考。

 

预购地址:http://www.china-pub.com/39292

【作  者】罗刚君
【出 版 社】 电子工业出版社     【书 号】 9787121057793

【出版日期】 2008 年3月 【开 本】 16开 【页 码】 585     

编辑推荐

1、用实例说话.
2、人性化讲解..
3、实力派作者队伍
实力派作者,350个范例,让您全面掌握Excel VBA。
5大措施,更方便读者学习...

原创粉丝点击