frmemployee.frm

人事管理系统的一个比较不错的VB软件 有管理系统的功能

   Me.Width = 10500
   
   Me.Left = (Screen.Width - Me.Width) / 2
   Me.Top = 0
   
   FlagEndabled = CheckProgramLimit("hrd201")
   
   cmdSave.Enabled = FlagEndabled
   cmdDelete.Enabled = FlagEndabled
   cmdExperienceSave.Enabled = FlagEndabled
   cmdExperienceDelete.Enabled = FlagEndabled
   cmdSchoolSave.Enabled = FlagEndabled
   cmdSchoolDelete.Enabled = FlagEndabled
   cmdPaySave.Enabled = FlagEndabled
   
   Call Init
End Sub

Private Sub Init()
   Dim i As Integer
   Dim TvHead, TvHeadSchool As ColumnHeader
   
   DTPBirthDate.Value = Date  '出生日期
   DTPInIncDate.Value = Date  '进厂日期
   
   DTPBeginDate.Value = Date  '经历的起始日期
   DTPEndDate.Value = Date   '　　　　终止日期
  
   DTPFinishDate.Value = Date '学历的毕业时间
   
   txtSql = "select * from dept"
   
   Set mrc = Nothing
   
   Set mrc = ExecuteSQL(txtSql)
   ReDim ArrayDept(mrc.RecordCount, 2)
   DeptRecord = mrc.RecordCount
   i = 0
   Do While Not mrc.EOF
       ComboDept.AddItem mrc.Fields(1).Value, i
       ArrayDept(i, 0) = mrc.Fields(0).Value
       ArrayDept(i, 1) = mrc.Fields(1).Value
       i = i + 1
       mrc.MoveNext
    Loop
    
    Set mrc = Nothing
    
    ComboSex.AddItem "男", 0
    ComboSex.AddItem "女", 1
    
    ArraySex(0) = "男"
    ArraySex(1) = "女"
     
         
    Set TvHead = LViewExperience.ColumnHeaders.Add(, "h01", "序号", 0)
    Set TvHead = LViewExperience.ColumnHeaders.Add(, "h02", "起始时间", 1500)
    Set TvHead = LViewExperience.ColumnHeaders.Add(, "h03", "终止时间", 1500)
    Set TvHead = LViewExperience.ColumnHeaders.Add(, "h04", "所在公司", 3000)
    Set TvHead = LViewExperience.ColumnHeaders.Add(, "h05", "所在部门", 1000)
    Set TvHead = LViewExperience.ColumnHeaders.Add(, "h06", "职务", 1000)
    
    Set TvHead = LViewSchool.ColumnHeaders.Add(, "h01", "序号", 0)
    Set TvHead = LViewSchool.ColumnHeaders.Add(, "h02", "学历", 1000)
    Set TvHead = LViewSchool.ColumnHeaders.Add(, "h03", "学位", 1000)
    Set TvHead = LViewSchool.ColumnHeaders.Add(, "h04", "学制", 1000)
    Set TvHead = LViewSchool.ColumnHeaders.Add(, "h05", "专业", 1000)
    Set TvHead = LViewSchool.ColumnHeaders.Add(, "h06", "院校", 3000)
    Set TvHead = LViewSchool.ColumnHeaders.Add(, "h07", "毕业时间", 1000)
    
    Call dispPic '
    
    pic(0).Visible = True  '初始显示经历
    'txtId.SetFocus
End Sub





Private Sub LViewExperience_BeforeLabelEdit(Cancel As Integer)
   Cancel = 1
End Sub

Private Sub LViewExperience_ItemClick(ByVal Item As MSComctlLib.ListItem)
    DTPBeginDate.Value = Item.SubItems(1)
    DTPEndDate.Value = Item.SubItems(2)
    txtjl(0).Text = Item.SubItems(3)
    txtjl(1).Text = Item.SubItems(4)
    txtjl(2).Text = Item.SubItems(5)
End Sub

Private Sub LViewSchool_BeforeLabelEdit(Cancel As Integer)
   Cancel = 1
End Sub

Private Sub LViewSchool_ItemClick(ByVal Item As MSComctlLib.ListItem)
   txtSchool(0).Text = Item.SubItems(1)
   txtSchool(1).Text = Item.SubItems(2)
   txtSchool(2).Text = Item.SubItems(3)
   txtSchool(3).Text = Item.SubItems(4)
   txtSchool(4).Text = Item.SubItems(5)
   DTPFinishDate.Value = Item.SubItems(6)
   
End Sub

Private Sub txtAddress_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      DTPBirthDate.SetFocus
   End If
End Sub





Private Sub txtArtTitle_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      cmdSave.SetFocus
   End If
End Sub

Private Sub txtFolk_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      txtPolrtyFace.SetFocus
   End If
End Sub



Private Sub txtHealth_KeyPress(KeyAscii As Integer)
   
   If KeyAscii = 13 Then
      txtArtTitle.SetFocus
   End If
End Sub

Private Sub txtId_Change()
   Dim i As Integer
   
   txtSql = " select * from employee where Id ='" & txtId.Text & "'"
   
   Set mrc = Nothing
   
   Set mrc = ExecuteSQL(txtSql)
   
   If Not mrc.EOF Then
      txtName.Text = mrc.Fields(1)
      For i = 0 To DeptRecord - 1
         If ArrayDept(i, 0) = mrc.Fields(2) Then
            Exit For
         End If
      Next i
      ComboDept.ListIndex = i
      ComboDept.Text = ArrayDept(i, 1)
      
      ComboSex.Text = mrc.Fields(3)
      txtIDCard.Text = mrc.Fields(4)
      txtAddress.Text = mrc.Fields(5)
      DTPBirthDate.Value = mrc.Fields(6)
      DTPInIncDate.Value = mrc.Fields(7)
      txtJob.Text = mrc.Fields(8)
      txtWedlock.Text = mrc.Fields(9)
      txtSchoolAge.Text = mrc.Fields(10)
      txtFolk.Text = mrc.Fields(11)
      txtPolrtyFace.Text = mrc.Fields(12)
      txtHealth.Text = mrc.Fields(13)
      txtArtTitle.Text = mrc.Fields(14)
    
      
   Else
      txtName.Text = ""
      ComboDept.Text = ""
      ComboSex.Text = ""
      txtIDCard.Text = ""
      txtAddress.Text = ""
      DTPBirthDate.Value = Date
      DTPInIncDate.Value = Date
      txtJob.Text = ""
      txtWedlock.Text = ""
      txtSchoolAge.Text = ""
      txtFolk.Text = ""
      txtPolrtyFace.Text = ""
      txtHealth.Text = ""
      txtArtTitle.Text = ""
   End If
    ShowListExperience  '显示经历
      
    ShowListSchool    '显示学历
      
    ShowPay  '显示工资结构
   
End Sub

Private Sub txtId_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      txtName.SetFocus
   End If
End Sub




Private Sub txtIDCard_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      txtAddress.SetFocus
   End If
End Sub



Private Sub txtJob_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      txtWedlock.SetFocus
   End If
End Sub

Private Sub txtName_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      ComboDept.SetFocus
   End If
End Sub





Private Sub txtPolrtyFace_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      txtHealth.SetFocus
   End If
End Sub

Private Sub txtSchool_KeyPress(Index As Integer, KeyAscii As Integer)
   If KeyAscii = 13 Then
      If Index < 4 Then
         txtSchool(Index + 1).SetFocus
      Else
         DTPFinishDate.SetFocus
      End If
   End If
End Sub

Private Sub txtSchoolAge_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      txtFolk.SetFocus
   End If
End Sub



Private Sub txtWedlock_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      txtSchoolAge.SetFocus
   End If
End Sub

Private Sub ShowListExperience()
   Dim i As Integer
   Dim LvDate As ListItem
     
   LViewExperience.ListItems.Clear
    
   txtSql = "select * from experience where Id ='" & txtId.Text & "'"
    
   Set mrc = Nothing
   Set mrc = ExecuteSQL(txtSql)
   i = 1
   Do While Not mrc.EOF
       Set LvData = LViewExperience.ListItems.Add(, "d" & i, i, 1, 1)
           LvData.SubItems(1) = mrc.Fields(1).Value
           LvData.SubItems(2) = mrc.Fields(2).Value
           LvData.SubItems(3) = mrc.Fields(3).Value
           LvData.SubItems(4) = mrc.Fields(4).Value
           LvData.SubItems(5) = mrc.Fields(5).Value
           
       i = i + 1
       mrc.MoveNext
    Loop
     
    mrc.Close
End Sub
Private Sub ShowListSchool()
   Dim i As Integer
   Dim LvDate As ListItem
     
   LViewSchool.ListItems.Clear
    
   txtSql = "select * from School where Id ='" & txtId.Text & "'"
    
   Set mrc = Nothing
   Set mrc = ExecuteSQL(txtSql)
   i = 1
   Do While Not mrc.EOF
       Set LvData = LViewSchool.ListItems.Add(, "d" & i, i, 1, 1)
           LvData.SubItems(1) = mrc.Fields(1).Value
           LvData.SubItems(2) = mrc.Fields(2).Value
           LvData.SubItems(3) = mrc.Fields(3).Value
           LvData.SubItems(4) = mrc.Fields(4).Value
           LvData.SubItems(5) = mrc.Fields(5).Value
           LvData.SubItems(6) = mrc.Fields(6).Value
       i = i + 1
       mrc.MoveNext
    Loop
     
    mrc.Close
End Sub
Private Sub ShowPay()
   txtSql = "select * from pay where Id ='" & txtId.Text & "'"
   Set mrc = Nothing
   Set mrc = ExecuteSQL(txtSql)
   If mrc.EOF = False Then
      txtPay(0).Text = mrc.Fields(1).Value
      txtPay(1).Text = mrc.Fields(2).Value
      txtPay(2).Text = mrc.Fields(3).Value
      txtPay(3).Text = mrc.Fields(4).Value
   End If
   
End Sub

Private Function check_employee() As Boolean
   check_employee = True
   If txtId.Text = "" Then
      MsgBox "员工编号不能为空", vbCritical + vbOKOnly, "错误提示： "
      txtId.SetFocus
      check_employee = False
      Exit Function
   End If
   If txtName.Text = "" Then
      MsgBox "姓名不能为空", vbCritical + vbOKOnly, "错误提示： "
      txtName.SetFocus
      check_employee = False
      Exit Function
   End If
   If ComboDept.Text = "" Then
      MsgBox "部门不能为空", vbCritical + vbOKOnly, "错误提示： "
      ComboDept.SetFocus
      check_employee = False
      Exit Function
   End If
   If ComboSex.Text = "" Then
      MsgBox "性别不能为空", vbCritical + vbOKOnly, "错误提示： "
      ComboSex.SetFocus
      check_employee = False
      Exit Function
   End If
   If txtIDCard.Text = "" Then
      MsgBox "身份证不能为空", vbCritical + vbOKOnly, "错误提示： "
      txtIDCard.SetFocus
      check_employee = False
      Exit Function
   End If
   
End Function
Private Function check_experience() As Boolean
   check_experience = True
   If txtId.Text = "" Then
      MsgBox "员工编号不能为空", vbCritical + vbOKOnly, "错误提示： "
      txtId.SetFocus
      check_experience = False
      Exit Function
   End If
   If DTPBeginDate.Value = "" Then
       MsgBox "日期不能为空", vbCritical + vbOKOnly, "错误提示： "
       DTPBeginDate.SetFocus
       check_experience = False
       Exit Function
   End If
   
End Function
Private Function check_school() As Boolean
   check_school = True
   If txtId.Text = "" Then
      MsgBox "员工编号不能为空", vbCritical + vbOKOnly, "错误提示： "
      txtId.SetFocus
      check_school = False
      Exit Function
   End If
   If txtSchool(0).Text = "" Then
      MsgBox "学历不能为空", vbCritical + vbOKOnly, "错误提示： "
      txtSchool(0).SetFocus
      check_school = False
      Exit Function
   End If
    If DTPFinishDate.Value = "" Then
      MsgBox "日期不能为空", vbCritical + vbOKOnly, "错误提示： "
      DTPFinishDate.SetFocus
      check_school = False
      Exit Function
   End If
End Function
Private Function check_pay() As Boolean
   Dim i As Integer
   check_pay = True
   If txtId.Text = "" Then
      MsgBox "员工编号不能为空", vbCritical + vbOKOnly, "错误提示： "
      txtId.SetFocus
      check_pay = False
      Exit Function
   End If
   For i = 0 To txtPay.Count - 1
      If IsNumeric(txtPay(i).Text) = False Then
         MsgBox "不是数字", vbCritical + vbOKOnly, "错误提示： "
         txtPay(i).SetFocus
         check_pay = False
         Exit Function
      End If
   Next i
End Function