f_peixunxiangmushishi.frm

公司人员综合管理系统 提供公司人员的简历、工资账目、考勤、医疗纪录、失业保险等情况

  
  If mbAddNewFlag Then
    adoPrimaryRS.MoveLast              'move to the new record
  End If

  mbEditFlag = False
  mbAddNewFlag = False
  SetButtons True
  
  Exit Function

UpdateErr:
  UpdateData = False

End Function

Private Sub DataGrid1_Error(ByVal DataError As Integer, Response As Integer)
Response = 0
    MsgBox "输入数据不合法，请输入合法数据！", vbExclamation + vbOKOnly, pTitle
End Sub

Private Sub Form_Load()
On Error Resume Next
    For Each TextBox In Me.Controls
        TextBox.Font.Name = "宋体"
        TextBox.Font.Size = 9
    Next

  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "SHAPE {select 培训实施计划编号, 培训实施编号,时间,部门,项目名称,培训计划编号,培训种类,培训对象,计划举办日期,计划培训时数,计划参加人数,实际举办日期,实际培训时数,实际参加人数,变动说明,培训费用直接预算,培训费用直接实际,培训费用间接预算,培训费用间接实际,培训费用合计预算,培训费用合计实际,费用变动说明,服务年限,培训内容,口试,笔试,实际操作,主办部门成绩评估,人力资源部成绩评估,主办部门负责人签字,主办部门签字时间,人力资源部负责人签字,人力资源部签字时间 from 培训项目实施表} AS ParentCMD APPEND ({select 培训项目实施编号,员工号,姓名,口试成绩,笔试成绩,实际操作成绩,培训费 from 培训项目实施人员 } AS ChildCMD RELATE  培训实施编号 TO 培训项目实施编号) AS ChildCMD", db1, adOpenStatic, adLockBatchOptimistic

 Set DTPicker1.DataSource = adoPrimaryRS
 Set DTPicker2.DataSource = adoPrimaryRS
 Set DTPicker3.DataSource = adoPrimaryRS
 Set DTPicker4.DataSource = adoPrimaryRS
 
 SetButtons True
       
 Set Check1.DataSource = adoPrimaryRS
 Set Check2.DataSource = adoPrimaryRS
 Set Check3.DataSource = adoPrimaryRS
 
 Set DataGrid2.DataSource = adoPrimaryRS
  
  Dim oText As TextBox
  'Bind the text boxes to the data provider
  'For Each oText In Me.txtFields
   ' Set oText.DataSource = adoPrimaryRS
  'Next

 Set txtFields(10).DataSource = adoPrimaryRS
 Set txtFields(2).DataSource = adoPrimaryRS
 Set txtFields(0).DataSource = adoPrimaryRS
 Set txtFields(3).DataSource = adoPrimaryRS
 Set txtFields(4).DataSource = adoPrimaryRS
 Set txtFields(5).DataSource = adoPrimaryRS
 Set txtFields(6).DataSource = adoPrimaryRS
 Set txtFields(20).DataSource = adoPrimaryRS
 Set txtFields(8).DataSource = adoPrimaryRS
 Set txtFields(9).DataSource = adoPrimaryRS
 Set txtFields(12).DataSource = adoPrimaryRS
 Set txtFields(11).DataSource = adoPrimaryRS
 Set txtFields(19).DataSource = adoPrimaryRS
Set txtFields(13).DataSource = adoPrimaryRS
Set txtFields(14).DataSource = adoPrimaryRS
Set txtFields(15).DataSource = adoPrimaryRS
Set txtFields(16).DataSource = adoPrimaryRS
 Set txtFields(17).DataSource = adoPrimaryRS
 Set txtFields(18).DataSource = adoPrimaryRS
Set txtFields(26).DataSource = adoPrimaryRS
Set txtFields(1).DataSource = adoPrimaryRS
Set txtFields(7).DataSource = adoPrimaryRS
Set txtFields(22).DataSource = adoPrimaryRS
Set txtFields(21).DataSource = adoPrimaryRS
Set txtFields(24).DataSource = adoPrimaryRS




 If adoPrimaryRS.RecordCount <> 0 Then
  Set DataGrid1.DataSource = adoPrimaryRS("ChildCMD").UnderlyingValue
End If
  mbDataChanged = False
  
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End Sub

Private Sub cmdAdd_Click()
  On Error GoTo AddErr

  
  
 With adoPrimaryRS
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    End If
    .AddNew

    mbAddNewFlag = True
    SetButtons False
  End With

  Exit Sub
AddErr:
  MsgBox "增加操作有错误", vbExclamation + vbOKOnly, pTitle
  
End Sub

Private Sub cmdDelete_Click()
Dim adochild As ADODB.Recordset
  On Error GoTo DeleteErr
  Result = MsgBox("此操作将删除此记录所有信息，你真的要删除吗？", vbExclamation + vbYesNo + vbDefaultButton2, "提示")
  If Result = 6 Then                                    '选择YES
  
        '删除子表记录
        
       Set adochild = New Recordset
       Set adochild = adoPrimaryRS("ChildCMD").UnderlyingValue
       While Not adochild.EOF
            adochild.Delete
            adochild.MoveNext
       Wend
       adochild.UpdateBatch adAffectAll
       adochild.CLOSE
       Set adochild = Nothing
       
       '删除父表的当前记录
       
       With adoPrimaryRS
         .Delete
         .UpdateBatch adAffectCurrent
         .MoveNext
         If .EOF Then .MoveLast
       End With
  End If
  Exit Sub
 
DeleteErr:
  MsgBox "删除数据失败！", vbExclamation + vbOKOnly, "Ptitle"
End Sub

Private Sub cmdRefresh_Click()
  'This is only needed for multi user apps
  On Error GoTo RefreshErr
  adoPrimaryRS.Requery
  Exit Sub
RefreshErr:
   MsgBox "刷新操作有错误", vbExclamation + vbOKOnly, pTitle
End Sub

Private Sub cmdEdit_Click()
  On Error GoTo EditErr
  mbEditFlag = True
  SetButtons False
  Exit Sub

EditErr:
   MsgBox "更改操作有错误", vbExclamation + vbOKOnly, pTitle
End Sub
Private Sub cmdCancel_Click()
 ' On Error Resume Next
 On Error GoTo CancelErr


  mbEditFlag = False
  mbAddNewFlag = False
  adoPrimaryRS.CancelUpdate

 ' If mvBookMark > 0 Then
 '  adoPrimaryRS.Bookmark = mvBookMark
  'Else
   'adoPrimaryRS.MoveFirst
  'End If
 SetButtons True
  Exit Sub
CancelErr:
   
   MsgBox "取消操作有错误", vbExclamation + vbOKOnly, pTitle

End Sub

Private Sub cmdUpdate_Click()
  Dim blnUpdateFlag As Boolean
  blnUpdateFlag = UpdateData
  If blnUpdateFlag = True Then
    MsgBox "数据保存成功！", vbInformation + vbOKOnly, "提示"
  Else
    MsgBox "数据保存失败！", vbExclamation + vbOKOnly, "警告"
  End If

End Sub

Private Sub cmdClose_Click()
  RSGL.Enabled = True
  Unload Me
End Sub

Private Sub SetButtons(bVal As Boolean)
  cmdAdd.Visible = bVal
  cmdEdit.Visible = bVal
  cmdUpdate.Visible = Not bVal
  cmdCancel.Visible = Not bVal
  cmdDelete.Visible = bVal
  cmdClose.Visible = bVal
  cmdRefresh.Visible = bVal
  
  For Each oText In Me.txtFields
        oText.Enabled = Not bVal
  Next
  
  DTPicker1.Enabled = Not bVal
  DTPicker2.Enabled = Not bVal
  DTPicker3.Enabled = Not bVal
  DTPicker4.Enabled = Not bVal
        
  Check1.Enabled = Not bVal
  Check2.Enabled = Not bVal
  Check3.Enabled = Not bVal
  
  If bVal Then
   Set DataGrid2.DataSource = adoPrimaryRS
  Else
   Set DataGrid2.DataSource = Nothing
  End If
  
  If Not bVal Then
    If mbEditFlag Then
     DataGrid1.AllowAddNew = True
     DataGrid1.AllowDelete = True
     DataGrid1.AllowUpdate = True
    End If
  Else
     DataGrid1.AllowAddNew = False
     DataGrid1.AllowDelete = False
     DataGrid1.AllowUpdate = False
  End If
    
End Sub


Private Sub txtFields_Change(Index As Integer)

  If IsNumeric(txtFields(13).Text) And IsNumeric(txtFields(15).Text) And IsNumeric(txtFields(13).Text) Then
  
   txtFields(17) = CDbl(txtFields(13)) + CDbl(txtFields(15))
   
  End If
  
  If IsNumeric(txtFields(14).Text) And IsNumeric(txtFields(16).Text) And IsNumeric(txtFields(13).Text) Then
  
   
    txtFields(18) = CDbl(txtFields(14)) + CDbl(txtFields(16))
  End If
  
End Sub

Private Sub txtFields_LostFocus(Index As Integer)
Select Case Index

Case 10

    If Not IsNull(Trim(txtFields(10).Text)) Then
        '  txtFields(10).Locked = True
    End If


Case 0
Dim Sql3 As String


 Sql3 = "select  培训计划编号,实施计划编号,时间,部门,项目名称,培训种类,培训对象,参加人数,举办日期,地点,培训时数,师资来源,培训目的,课时费,租用费,招待费,交通费,教材费,工时占用费用,其他费用,预算费用合计,培训内容,口试,笔试,实际操作 from 培训实施计划表 where 实施计划编号 = '" & txtFields(0).Text & "'"
 Set rs3 = db.Execute(Sql3)
 If Not rs3.EOF Then
 

   If Not IsNull(rs3("项目名称")) Then
       txtFields(3).Text = Trim(rs3("项目名称"))
   End If
   
   If Not IsNull(rs3("培训计划编号")) Then
       txtFields(4).Text = Trim(rs3("培训计划编号"))
   End If
   
   If Not IsNull(rs3("培训种类")) Then
       txtFields(5).Text = Trim(rs3("培训种类"))
   End If
   
   If Not IsNull(rs3("培训对象")) Then
       txtFields(6).Text = Trim(rs3("培训对象"))
   End If
   
   If Not IsNull(rs3("举办日期")) Then
       DTPicker2.Value = Trim(rs3("举办日期"))
   End If
   
   If Not IsNull(rs3("培训时数")) Then
       txtFields(8).Text = Trim(rs3("培训时数"))
   End If
   
   If Not IsNull(rs3("参加人数")) Then
       txtFields(9).Text = Trim(rs3("参加人数"))
   End If
   
   
    If Not IsNull(rs3("培训内容")) Then
     txtFields(1).Text = Trim(rs3("培训内容"))
   End If
   
   If Not IsNull(rs3("口试")) And rs3("口试") = True Then
     Check1.Value = 1
    Else
      Check1.Value = 0
   End If
   
   If Not IsNull(rs3("笔试")) And rs3("笔试") = True Then
     Check2.Value = 1
    Else
      Check2.Value = 0
   End If
   
   If Not IsNull(rs3("实际操作")) And rs3("实际操作") = True Then
     Check3.Value = 1
    Else
      Check3.Value = 0
   End If
   
End If



Case 8

If Not IsNumeric(txtFields(8).Text) And (txtFields(8).Text <> "") Then
    MsgBox "请在“计划培训时数”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(8).SetFocus
     txtFields(8).SelStart = 0
     txtFields(8).SelLength = Len(txtFields(8))
     
End If

Case 9
If Not IsNumeric(txtFields(9).Text) And (txtFields(9).Text <> "") Then
    MsgBox "请在“计划参加人数”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(9).SetFocus
     txtFields(9).SelStart = 0
     txtFields(9).SelLength = Len(txtFields(9))
     
End If

Case 11
If Not IsNumeric(txtFields(11).Text) And (txtFields(11).Text <> "") Then
    MsgBox "请在“实际培训时数”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(11).SetFocus
     txtFields(11).SelStart = 0
     txtFields(11).SelLength = Len(txtFields(11))
 
End If

Case 12
If Not IsNumeric(txtFields(12).Text) And (txtFields(12).Text <> "") Then
    MsgBox "请在“实际参加人数”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(12).SetFocus
     txtFields(12).SelStart = 0
     txtFields(12).SelLength = Len(txtFields(12))
     
End If

Case 13
If Not IsNumeric(txtFields(13).Text) And (txtFields(13).Text <> "") Then
    MsgBox "请在“培训费用直接预算”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(13).SetFocus
     txtFields(13).SelStart = 0
     txtFields(13).SelLength = Len(txtFields(13))
     
End If

Case 14
If Not IsNumeric(txtFields(14).Text) And (txtFields(14).Text <> "") Then
    MsgBox "请在“培训费用直接实际费用”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(14).SetFocus
      txtFields(14).SelStart = 0
     txtFields(14).SelLength = Len(txtFields(14))
    
End If

Case 15
If Not IsNumeric(txtFields(15).Text) And (txtFields(15).Text <> "") Then
    MsgBox "请在“培训费用间接预算”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(15).SetFocus
     txtFields(15).SelStart = 0
     txtFields(15).SelLength = Len(txtFields(15))
     
End If

Case 16
If Not IsNumeric(txtFields(16).Text) And (txtFields(16).Text <> "") Then
    MsgBox "请在“培训费用间接实际费用”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(16).SetFocus
     txtFields(16).SelStart = 0
     txtFields(16).SelLength = Len(txtFields(16))
     
End If


End Select
If Index = 2 And Not IsNull(txtFields(10)) Then
    txtFields(10).Locked = True
End If
End Sub