f_peixunshishijihua1.frm

vb开发的人事管理系统

  adoPrimaryRS.Open "SHAPE {select 培训计划编号,实施计划编号,时间,部门,项目名称,培训种类,培训对象,参加人数,举办日期,地点,培训时数,师资来源,培训目的,课时费,租用费,招待费,交通费,教材费,工时占用费用,其他费用,预算费用合计,培训内容,口试,笔试,实际操作,人力资源部经理签字,人力资源部签字时间,财务部经理签字,财务部签字时间,总经理签字,总经理签字时间,部门申请人签字,部门申请人签字时间 from 培训实施计划表} AS ParentCMD APPEND ({select 培训实施计划编号,员工号,姓名,岗位 from 培训实施计划人员 } AS ChildCMD RELATE 实施计划编号 TO 培训实施计划编号) AS ChildCMD", db1, adOpenStatic, adLockBatchOptimistic

  If adoPrimaryRS.RecordCount <> 0 Then
      Set DataGrid2.DataSource = adoPrimaryRS
 End If
 SetButtons True
 
 Set DTPicker1.DataSource = adoPrimaryRS
 Set DTPicker2.DataSource = adoPrimaryRS
 Set DTPicker3.DataSource = adoPrimaryRS
 Set DTPicker4.DataSource = adoPrimaryRS
 Set DTPicker5.DataSource = adoPrimaryRS
 Set DTPicker6.DataSource = adoPrimaryRS
       
 Set Check1.DataSource = adoPrimaryRS
 Set Check2.DataSource = adoPrimaryRS
 Set Check3.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

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

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)
Dim oText As TextBox
  
  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
  DTPicker5.Enabled = Not bVal
  DTPicker6.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 grdDataGrid_Error(ByVal DataError As Integer, Response As Integer)
Response = 0
    MsgBox "输入数据不合法，请输入合法数据！", vbExclamation + vbOKOnly, pTitle
End Sub

Private Sub txtFields_Change(Index As Integer)

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

Private Sub txtFields_LostFocus(Index As Integer)

Select Case Index

Case 8

    If Not IsNull(Trim(txtFields(8).Text)) Then
       '   txtFields(8).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(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(7).Text = Trim(rs3("参加人数"))
   End If
   
   
   
   If Not IsNull(rs3("地点")) Then
       txtFields(9).Text = Trim(rs3("地点"))
   End If
   
   If Not IsNull(rs3("培训时数")) Then
       txtFields(10).Text = Trim(rs3("培训时数"))
   End If
   
   If Not IsNull(rs3("师资来源")) Then
       txtFields(11).Text = Trim(rs3("师资来源"))
   End If
   
   If Not IsNull(rs3("培训目的")) Then
       txtFields(1).Text = Trim(rs3("培训目的"))
   End If
 
   If Not IsNull(rs3("课时费")) Then
     txtFields(13).Text = Trim(rs3("课时费"))
   End If
   
   If Not IsNull(rs3("租用费")) Then
     txtFields(14).Text = Trim(rs3("租用费"))
   End If
   
   If Not IsNull(rs3("招待费")) Then
     txtFields(15).Text = Trim(rs3("招待费"))
   End If
   
   If Not IsNull(rs3("交通费")) Then
     txtFields(16).Text = Trim(rs3("交通费"))
   End If
   
   If Not IsNull(rs3("教材费")) Then
     txtFields(17).Text = Trim(rs3("教材费"))
   End If
   
   If Not IsNull(rs3("工时占用费")) Then
     txtFields(18).Text = Trim(rs3("工时占用费"))
   End If
   
   If Not IsNull(rs3("其他费用")) Then
     txtFields(19).Text = Trim(rs3("其他费用"))
   End If
   
   If Not IsNull(rs3("预算费用合计")) Then
     txtFields(20).Text = Trim(rs3("预算费用合计"))
   End If
   
    If Not IsNull(rs3("培训内容")) Then
     txtFields(4).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 5
If Not IsNumeric(txtFields(7).Text) And (txtFields(7).Text <> "") Then
    MsgBox "请在“参加人数”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(7).SetFocus
     txtFields(7).SelStart = 0
     txtFields(7).SelLength = Len(txtFields(7))
  
End If
Case 10
If Not IsNumeric(txtFields(10).Text) And (txtFields(10).Text <> "") Then
    MsgBox "请在“培训时数”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(10).SetFocus
     txtFields(10).SelStart = 0
     txtFields(10).SelLength = Len(txtFields(10))
     
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
Case 17
If Not IsNumeric(txtFields(17).Text) And (txtFields(17).Text <> "") Then
    MsgBox "请在“教材费”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(17).SetFocus
      txtFields(17).SelStart = 0
     txtFields(17).SelLength = Len(txtFields(17))
    
End If


Case 18
If Not IsNumeric(txtFields(18).Text) And (txtFields(18).Text <> "") Then
    MsgBox "请在“工时占用费”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(18).SetFocus
     txtFields(18).SelStart = 0
     txtFields(18).SelLength = Len(txtFields(18))
     
End If
Case 19
If Not IsNumeric(txtFields(19).Text) And (txtFields(19).Text <> "") Then
    MsgBox "请在“其他费用”中输入数字", vbExclamation + vbOKOnly, pTitle
     txtFields(19).SetFocus
     txtFields(19).SelStart = 0
     txtFields(19).SelLength = Len(txtFields(19))
     
End If
End Select

txtFields(8).Locked = True
End Sub