frmemployee.frm

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

      Width           =   675
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "性别"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   5535
      TabIndex        =   3
      Top             =   220
      Width           =   450
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "部门"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   3705
      TabIndex        =   2
      Top             =   220
      Width           =   450
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "姓名"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   1875
      TabIndex        =   1
      Top             =   220
      Width           =   450
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "员工号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   0
      Top             =   220
      Width           =   675
   End
End
Attribute VB_Name = "frmEmployee"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public mrc As ADODB.Recordset
Dim txtSql As String
Dim ArrayDept() As String  '定义部门代号数组
Dim ArraySex(2) As String  '定义性别数组
Dim DeptRecord As Integer  '部门代号记录总数


Private Sub cmdDelete_Click()
   Dim i As Integer
   If Not check_employee Then
      Exit Sub
   End If
   
   txtSql = "delete from employee where Id='" & txtId.Text & "'"
    
   i = MsgBox("是否真的要删除这个员工的资料", vbYesNo, "信息提示")
   
   If i = vbYes Then
    
      Set mrc = Nothing
    
      Set mrc = ExecuteSQL(txtSql)
      '删除经历
      txtSql = "delete from experience where Id ='" & txtId.Text & "'"
      Set mrc = Nothing
      Set mrc = ExecuteSQL(txtSql)
      
       '删除学历
      txtSql = "delete from school where Id ='" & txtId.Text & "'"
      Set mrc = Nothing
      Set mrc = ExecuteSQL(txtSql)
       '删除工资结构
      txtSql = "delete from pay where Id ='" & txtId.Text & "'"
      Set mrc = Nothing
      Set mrc = ExecuteSQL(txtSql)
      
      Call txtId_Change
      
   End If
   
End Sub

Private Sub cmdExperience_Click()
   
   Call dispPic
   
   pic(0).Visible = True
End Sub

Private Sub dispPic()
   Dim i As Integer
   For i = 0 To pic.Count - 1
     pic(i).Visible = False
   Next i
End Sub

Private Sub cmdExperienceDelete_Click()
   If Not check_experience Then
      Exit Sub
   End If
   txtSql = "delete from experience where Id='" & txtId.Text & "' and BeginDate='" & DTPBeginDate.Value & "'"
   
   Set mrc = Nothing
   Set mrc = ExecuteSQL(txtSql)
   
   ShowListExperience
    
   Clear_experience
   
End Sub

Private Sub cmdExperienceSave_Click()
   If Not check_experience Then
      Exit Sub
   End If
    '判断是否新增的SQL语句
   txtSql = "select * from experience where BeginDate='" & DTPBeginDate.Value & "' and Id ='" & txtId.Text & "'"
  
   Set mrc = Nothing
    
   Set mrc = ExecuteSQL(txtSql)
   
   If mrc.EOF = False Then
      mrc.Fields(2) = DTPEndDate.Value
      mrc.Fields(3) = txtjl(0).Text
      mrc.Fields(4) = txtjl(1).Text
      mrc.Fields(5) = txtjl(2).Text
      mrc.Update
   Else
      txtSql = "select * from experience"
      Set mrc = Nothing
      Set mrc = ExecuteSQL(txtSql)
      mrc.AddNew
      mrc.Fields(0) = txtId.Text
      mrc.Fields(1) = DTPBeginDate.Value
      mrc.Fields(2) = DTPEndDate.Value
      mrc.Fields(3) = txtjl(0).Text
      mrc.Fields(4) = txtjl(1).Text
      mrc.Fields(5) = txtjl(2).Text
      mrc.Update
   End If
    
    Set mrc = Nothing
    
    MsgBox "存盘成功", vbCritical + vbOKOnly, "信息提示： "
       
    ShowListExperience
    
    Clear_experience
End Sub

Private Sub Clear_experience()
    DTPBeginDate.Value = Date
    DTPEndDate.Value = Date
    txtjl(0).Text = ""
    txtjl(1).Text = ""
    txtjl(2).Text = ""
End Sub
Private Sub Clear_School()
   Dim i As Integer
   For i = 0 To txtSchool.Count - 1
      txtSchool(i).Text = ""
   Next i
   DTPFinishDate.Value = Date
    
End Sub

Private Sub cmdPay_Click()
   Call dispPic
   pic(2).Visible = True
End Sub

Private Sub cmdPaySave_Click()
   If Not check_pay Then
      Exit Sub
   End If
    '判断是否新增的SQL语句
   txtSql = "select * from pay where Id='" & txtId.Text & "'"
   
   Set mrc = Nothing
   Set mrc = ExecuteSQL(txtSql)
   If mrc.EOF = False Then   '修改
      mrc.Fields(1) = txtPay(0).Text
      mrc.Fields(2) = txtPay(1).Text
      mrc.Fields(3) = txtPay(2).Text
      mrc.Fields(4) = txtPay(3).Text
      mrc.Update
   Else
      txtSql = "select * from pay"
      Set mrc = Nothing
      Set mrc = ExecuteSQL(txtSql)
      mrc.AddNew
      mrc.Fields(0) = txtId.Text
      mrc.Fields(1) = txtPay(0).Text
      mrc.Fields(2) = txtPay(1).Text
      mrc.Fields(3) = txtPay(2).Text
      mrc.Fields(4) = txtPay(3).Text
      mrc.Update
   End If
   
   MsgBox "存盘成功", vbCritical + vbOKOnly, "信息提示： "
   
End Sub

Private Sub cmdSave_Click()
   If Not check_employee Then
      Exit Sub
   End If
   
    '判断是否新增的SQL语句
   txtSql = "select * from employee where Id='" & txtId.Text & "'"
  
   Set mrc = Nothing
    
   Set mrc = ExecuteSQL(txtSql)
    
   If mrc.EOF = False Then   '修改
      
       mrc.Fields(1) = Trim(txtName.Text)
       mrc.Fields(2) = Trim(ArrayDept(ComboDept.ListIndex, 0))
       mrc.Fields(3) = ComboSex.Text
       mrc.Fields(4) = Trim(txtIDCard.Text)
       mrc.Fields(5) = Trim(txtAddress.Text)
       mrc.Fields(6) = DTPBirthDate.Value
       mrc.Fields(7) = DTPInIncDate.Value
       mrc.Fields(8) = Trim(txtJob.Text)
       mrc.Fields(9) = Trim(txtWedlock.Text)
       mrc.Fields(10) = Trim(txtSchoolAge.Text)
       mrc.Fields(11) = Trim(txtFolk.Text)
       mrc.Fields(12) = Trim(txtPolrtyFace.Text)
       mrc.Fields(13) = Trim(txtHealth.Text)
       mrc.Fields(14) = Trim(txtArtTitle.Text)
       mrc.Update
       
    Else                    '新增
       txtSql = "select * from employee"
       Set mrc = Nothing
       Set mrc = ExecuteSQL(txtSql)
       mrc.AddNew
       mrc.Fields(0) = txtId.Text
       mrc.Fields(1) = Trim(txtName.Text)
       mrc.Fields(2) = Trim(ArrayDept(ComboDept.ListIndex, 0))
       mrc.Fields(3) = ComboSex.Text
       mrc.Fields(4) = Trim(txtIDCard.Text)
       mrc.Fields(5) = Trim(txtAddress.Text)
       mrc.Fields(6) = DTPBirthDate.Value
       mrc.Fields(7) = DTPInIncDate.Value
       mrc.Fields(8) = Trim(txtJob.Text)
       mrc.Fields(9) = Trim(txtWedlock.Text)
       mrc.Fields(10) = Trim(txtSchoolAge.Text)
       mrc.Fields(11) = Trim(txtFolk.Text)
       mrc.Fields(12) = Trim(txtPolrtyFace.Text)
       mrc.Fields(13) = Trim(txtHealth.Text)
       mrc.Fields(14) = Trim(txtArtTitle.Text)
       mrc.Update
       
    End If
    
    Set mrc = Nothing
    
    MsgBox "存盘成功", vbCritical + vbOKOnly, "信息提示： "
    
   ' ShowList   ' 刷新数据
    
    'ClearTxt   '清除文本中的数据
   
   
End Sub

Private Sub cmdSchool_Click()
   Call dispPic
   pic(0).Visible = True
   pic(1).Visible = True
   
End Sub

Private Sub cmdSchoolDelete_Click()
   If Not check_school Then
      Exit Sub
   End If
   
   txtSql = "delete from school where Id='" & txtId.Text & "' and SchoolAge='" & txtSchool(0).Text & "'"
   
   Set mrc = Nothing
   Set mrc = ExecuteSQL(txtSql)
   
   ShowListSchool
    
   Clear_School
End Sub

Private Sub cmdSchoolSave_Click()
   If Not check_school Then
      Exit Sub
   End If
   
     '判断是否新增的SQL语句
   txtSql = "select * from school where SchoolAge='" & txtSchool(0).Text & "' and Id ='" & txtId.Text & "'"
  
   Set mrc = Nothing
    
   Set mrc = ExecuteSQL(txtSql)
   
   If mrc.EOF = False Then
      mrc.Fields(2) = txtSchool(1).Text
      mrc.Fields(3) = txtSchool(2).Text
      mrc.Fields(4) = txtSchool(3).Text
      mrc.Fields(5) = txtSchool(4).Text
      mrc.Fields(6) = DTPFinishDate.Value
      mrc.Update
   Else
      txtSql = "select * from school"
      Set mrc = Nothing
      Set mrc = ExecuteSQL(txtSql)
      mrc.AddNew
      mrc.Fields(0) = txtId.Text
      mrc.Fields(1) = txtSchool(0).Text
      mrc.Fields(2) = txtSchool(1).Text
      mrc.Fields(3) = txtSchool(2).Text
      mrc.Fields(4) = txtSchool(3).Text
      mrc.Fields(5) = txtSchool(4).Text
      mrc.Fields(6) = DTPFinishDate.Value
      mrc.Update
   End If
    
    Set mrc = Nothing
    
    MsgBox "存盘成功", vbCritical + vbOKOnly, "信息提示： "
       
    ShowListSchool
    
    Clear_School
   
End Sub

Private Sub ComboDept_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      ComboSex.SetFocus
   End If
End Sub




Private Sub ComboSex_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      txtIDCard.SetFocus
   End If
End Sub



Private Sub DTPBirthDate_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      DTPInIncDate.SetFocus
   End If
End Sub



Private Sub DTPInIncDate_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      txtJob.SetFocus
   End If
End Sub

Private Sub Form_Load()
   Dim FlagEnabled  As Boolean
   
   Me.Height = 8000