frmrs.frm

企业人事管理系统,有考勤,人员管理等功能,值得研究,也是我付费弄来的,绝对超值

  Else
    frmChgHM.txtDH = rs.Fields("联系电话").Value
  End If
  
  rs.Close
  
  frmChgHM.gh = fGH.Caption
  frmChgHM.iID = v
  frmChgHM.Show vbModal
  
End Sub


'修改工作信息
Public Sub cmdChgJob_Click()
  Dim iRow As Integer
  Dim strSql As String
  Dim strMsg As String
  Dim rs As ADODB.Recordset
  
  Dim rtn
   If grdJob.Row <= 0 Or frdhm > grdJob.Rows - 1 Then Exit Sub
   iRow = grdJob.Row
   'v为id号
   v = grdJob.TextMatrix(iRow, 1)
   If v = "" Then Exit Sub
   
  strSql = "select  * from t_Job where ID=" & v
   Set rs = ExecuteSQL(strSql, strMsg)
   
   frmChgJob.dtpBT = rs.Fields("开始时间").Value
   frmChgJob.dtpET = rs.Fields("结束时间").Value
   frmChgJob.txtDW = rs.Fields("工作单位").Value
   
   If IsNull(rs.Fields("部门名称").Value) Then
      frmChgJob.txtBM = ""
   Else
     frmChgJob.txtBM = rs.Fields("部门名称").Value
   End If
   
   If IsNull(rs.Fields("担任职务").Value) Then
   frmChgJob.txtZW = ""
   Else
   frmChgJob.txtZW = rs.Fields("担任职务").Value
   End If
   
   If IsNull(rs.Fields("级别")) Then
     frmChgJob.txtJB = ""
   Else
      frmChgJob.txtJB = rs.Fields("级别").Value
   End If
    rs.Close
  
  frmChgJob.gh = fGH.Caption
  frmChgJob.iID = v
  frmChgJob.Show vbModal
End Sub


'删除员工基本信息
Private Sub cmdDel_Click()
 Dim getRow As Integer
Dim getValue As String
   getRow = Grid1.Row
  If getRow < 1 Or getRow >= Grid1.Rows Then
  Exit Sub
  End If
  getValue = Grid1.TextMatrix(getRow, 1)
  
  Dim strSql As String
  Dim rs As ADODB.Recordset
  Dim strMsg As String
  Dim rtn
  rtn = MsgBox("是否要删除工号为" & getValue & "的记录", vbQuestion + vbYesNo)
  If rtn = vbNo Then Exit Sub
  
  strSql = "delete * from t_hm where 工号='" & getValue & "'"
  Set rs = ExecuteSQL(strSql, strMsg)
  
  strSql = "delete * from t_job where 工号='" & getValue & "'"
  Set rs = ExecuteSQL(strSql, strMsg)
  
  strSql = "delete * from t_br where 工号='" & getValue & "'"
  Set rs = ExecuteSQL(strSql, strMsg)
  

  Call RefreshGrid
 If Grid1.Rows > 1 Then
 Grid1.RowSel = 1
 Call Grid1_Click
 End If
End Sub

'删除家庭成员
Public Sub cmdDelHM_Click()
  Dim iRow As Integer
  Dim strSql As String
  Dim strMsg As String
  Dim rs As ADODB.Recordset
  
  Dim rtn
   If grdHM.Row <= 0 Or frdhm > grdHM.Rows - 1 Then Exit Sub
   iRow = grdHM.Row
   v = grdHM.TextMatrix(iRow, 1)
   If v = "" Then Exit Sub
   rtn = MsgBox("确定要删除ID为" & v & "的记录吗？", vbQuestion + vbYesNo)
   If rtn = vbNo Then Exit Sub
      
   strSql = "delete * from t_hm where id=" & v
    Set rs = ExecuteSQL(strSql, strMsg)
   ' MsgBox "成功删除!"
   
    Call showHM(fGH.Caption)
End Sub

'删除工作经历信息
Public Sub cmdDelJob_Click()
    Dim iRow As Integer
  Dim strSql As String
  Dim strMsg As String
  Dim rs As ADODB.Recordset
  
  Dim rtn
   If grdHM.Row <= 0 Or frdhm > grdHM.Rows - 1 Then Exit Sub
   iRow = grdHM.Row
   v = grdJob.TextMatrix(iRow, 1)
   If v = "" Then Exit Sub
   rtn = MsgBox("确定要删除ID为" & v & "的记录吗？", vbQuestion + vbYesNo)
   If rtn = vbNo Then Exit Sub
      
   strSql = "delete * from t_job where id=" & v
    Set rs = ExecuteSQL(strSql, strMsg)
   ' MsgBox "成功删除!"
   
    Call showJob(fGH.Caption)
End Sub

'删除照片
Private Sub cmdDelPhoto_Click()
   pic.Picture = LoadPicture("")
    strFileName = ""
    blnDelPhoto = True
End Sub

'退出
Private Sub cmdExit_Click()
   Unload Me
End Sub


Private Sub cmdExitHM_Click()
  Unload Me
End Sub

Private Sub cmdExitJob_Click()
  Unload Me
End Sub

'新建员工基本信息
Private Sub cmdNew_Click()

'使空件有用
  Call EnabledControl
  Dim o As Control
  i = 0
'清空text和combobox
  For Each o In Me
     If TypeName(o) = "TextBox" Or TypeName(o) = "ComboBox" Then
         o.Text = ""
     End If
  Next
  
  
  strFileName = ""
  pic.Picture = LoadPicture()
  
 cmdNew.Enabled = False
 cmdChange.Enabled = False
 cmdDel.Enabled = False
 
End Sub

'添加员工基本信息
Private Sub cmdOk_Click()
    Dim rs  As ADODB.Recordset
    Dim strSql As String
    Dim strMsg As String
    Dim tmpPath As String
    Dim iStm As ADODB.Stream
    
    '根据需要进行字段限制
    If txtGH = "" Then
      MsgBox "工号不能为空"
      TextFocus txtGH
      Exit Sub
    End If
    
    If txtName = "" Then
     MsgBox "姓名不能为空"
     TextFocus txtName
     Exit Sub
    End If
    
    If cboSex.Text = "" Then
      MsgBox "性别不能为空"
      TextFocus cboSex
      Exit Sub
    End If
    
    If cboSex.Text <> "男" And cboSex.Text <> "女" Then
      MsgBox "性别不对"
      TextFocus cboSex
      Exit Sub
    End If
    
    If Not IsNumeric(txtMoney) Then
      MsgBox "薪金应为数字"
      TextFocus txtMoney
      Exit Sub
    End If
    
    If Not IsNumeric(txtAge) Then
      MsgBox "年龄应为数字"
      TextFocus txtAge
      Exit Sub
    End If
       
    
    If Not IsNumeric(txtHandset) Then
      MsgBox "手机号码应为数字"
      TextFocus txtHandset
      Exit Sub
    End If
    
    
     If Not IsNumeric(txtIdentity) Then
      MsgBox "身份号码应为数字"
      TextFocus txtIdentity
      Exit Sub
    End If
    
     If Not IsNumeric(txtLong) Then
      MsgBox "工龄应为数字"
      TextFocus txtLong
      Exit Sub
    End If
    
    
    
    '合同时间处理
    If dtpEBargain.Value < dtpBBargain.Value Then
       MsgBox "合同终止时间不对"
       dtpEBargain.Value = dtpBBargain.Value
       Exit Sub
    End If
    
    '如果是修改(保存照片--删除原记录--保存记录)
    If blnChange = True Then
    '如果不要删除
    If blnDelPhoto = False Then
    
      strSql = "select * from t_br where 工号='" & txtGH.Text & "'"
      Set rs = ExecuteSQL(strSql, strMsg)
     '保存到文件
     tmpPath = App.path & "\temp.jpg"
    
     If Not IsNull(rs.Fields("照片").Value) Then
      Set iStm = New ADODB.Stream
     With iStm
        .Mode = adModeReadWrite
        .Type = adTypeBinary
        .Open
        .Write rs.Fields("照片").Value
        .SaveToFile tmpPath
      End With
        strFileName = tmpPath
        'pic.Picture = LoadPicture(tmpPath)
       ' Kill tmpPath
        iStm.Close
       End If
       rs.Close
       
     End If
       '删除记录
        strSql = "delete * from t_br where 工号='" & txtGH.Text & "'"
        Set rs = ExecuteSQL(strSql, strMsg)
  
        
       
    Else
    
   strSql = "select * from t_br where 工号='" & txtGH.Text & "'"
   Set rs = ExecuteSQL(strSql, strMsg)
   
    If rs.EOF = False Then
      MsgBox "已有相同的工号，无法添加到数据库！", vbOKOnly + vbExclamation, "警告"
         TextFocus txtGH
         Exit Sub
     End If
      rs.Close
      
    End If
    
   strSql = "select * from t_br"
   Set rs = ExecuteSQL(strSql, strMsg)
      rs.AddNew
      
      rs.Fields("工号") = txtGH.Text
      rs.Fields("姓名") = txtName.Text
      
      If cboPayStyle.Text = "" Then
       rs.Fields("工资类别") = Null
      Else
      rs.Fields("工资类别") = cboPayStyle.Text
      End If
      
      If cboHealthy.Text = "" Then
       rs.Fields("健康状况") = Null
      Else
      rs.Fields("健康状况") = cboHealthy.Text
      End If
      
         If cboSex.Text = "" Then
        rs.Fields("性别") = Null
      Else
      rs.Fields("性别") = cboSex.Text
      End If
            
      If cboEmployeeStyle.Text = "" Then
      rs.Fields("职工类型") = Null
      Else
      rs.Fields("职工类型") = cboEmployeeStyle.Text
      End If
      
      If cboPart.Text = "" Then
      rs.Fields("部门") = Null
      Else
      rs.Fields("部门") = cboPart.Text
      End If
      
      If cboDuty.Text = "" Then
      rs.Fields("职务") = Null
      Else
      rs.Fields("职务") = cboDuty.Text
      End If
      
      If cboCulture.Text = "" Then
      rs.Fields("文化程度") = Null
      Else
      rs.Fields("文化程度") = cboCulture.Text
      End If
      
         If cboNation.Text = "" Then
      rs.Fields("民族") = Null
      Else
      rs.Fields("民族") = cboNation.Text
      End If
      
      '数字型
      If txtMoney.Text = "" Then
      rs.Fields("薪金") = 0
      Else
      rs.Fields("薪金") = txtMoney.Text
      End If
      
      If cboSpec.Text = "" Then
      rs.Fields("所学专业") = Null
      Else
      rs.Fields("所学专业") = cboSpec.Text
      End If
      
      '年龄为数字型
      If txtAge.Text = "" Then
      rs.Fields("年龄") = 0
      Else
      rs.Fields("年龄") = txtAge.Text
      End If
      
      '日期型
      rs.Fields("生日") = dtpBirthday.Value
      
      If cboPolity.Text = "" Then
      rs.Fields("政治面貌") = Null
      Else
      rs.Fields("政治面貌") = cboPolity.Text
      End If
      
      If cboMarry.Text = "" Then
      rs.Fields("婚姻状况") = Null
      Else
      rs.Fields("婚姻状况") = cboMarry.Text
      End If
      
      If cboNativePlace.Text = "" Then
      rs.Fields("籍贯") = Null
      Else
      rs.Fields("籍贯") = cboNativePlace.Text
      End If
      
      If txtHandset.Text = "" Then
      rs.Fields("手机") = 0
      Else
      rs.Fields("手机") = txtHandset.Text
      End If
      
      If txtIdentity.Text = "" Then
      rs.Fields("身份证号") = Null
      Else
      rs.Fields("身份证号") = txtIdentity.Text
      End If
      
      If txtTelphone.Text = "" Then
      rs.Fields("联系电话") = Null
      Else
      rs.Fields("联系电话") = txtTelphone.Text
      End If
      
      If txtHomeAddress.Text = "" Then
       rs.Fields("家庭住址") = Null
      Else
      rs.Fields("家庭住址") = txtHomeAddress.Text
      End If
      
      '日期型
      rs.Fields("合同开始时间") = dtpBBargain.Value
      rs.Fields("合同终止时间") = dtpEBargain.Value
      
      If txtLong.Text = "" Then
      rs.Fields("工龄") = 0
      Else
      rs.Fields("工龄") = txtLong.Text
      End If
     
     
     
     
     '添加照片
      Set iStm = New ADODB.Stream
      If Len(strFileName) > 0 Then
      With iStm
        .Type = adTypeBinary    '二进制模式
        .Open
        .LoadFromFile strFileName
      End With
        rs.Fields("照片") = iStm.Read
        rs.Update
        iStm.Close
      
      Else
        rs.Update
        
      End If
        
      rs.Close
      Set rs = Nothing
      
      cmdDel.Enabled = True
      
      Call DisabledControl
      cmdNew.Enabled = True
      
      MsgBox "添加成功"
      Call RefreshGrid
      
      
End Sub




Private Sub cmdPrint_Click()
 frmDataOut.Show 1
End Sub

Private Sub cmdSearch_Click()
  frmFindbr.strTbName = "t_br"
 frmFindbr.Show vbModal
End Sub

Private Sub cmdShwAllRrd_Click()
  Call RefreshGrid
End Sub