f_bumenpeixunjihua.frm

用Visual basic6开发的人事信息管理系统,数据库采用的是Sql Server2000

        bbh = DataGrid1.Text
        
        Sql = "select 姓名 ,岗位名称 from 员工基本信息 where 员工号  =" & bbh & ""
        Set RS = db.Execute(Sql)
        DataGrid1.Col = 2
        DataGrid1.Row = t
      
        DataGrid1.Text = Trim(RS("姓名"))
        
        DataGrid1.Col = 3
        DataGrid1.Row = t
        DataGrid1.Text = Trim(RS("岗位名称"))
        
    End If
    
    
End Sub

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

Private Sub DTPickers_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then '
    SendKeys "{TAB}"
End If
End Sub

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

  Dim oText As TextBox
  'Bind the text boxes to the data provider
  If GANGWEI <> "总经理" Then
    For Each oText In Me.txtFields
        Set oText.DataSource = adoPrimaryRS
    Next
   Else
  End If
  
  SetButtons True
  
  If adoPrimaryRS.RecordCount <> 0 Then
       Set DataGrid1.DataSource = adoPrimaryRS("ChildCMD").UnderlyingValue
  End If
     
  Dim oDTP As DTPicker
  'Bind the DTPicker to the data provider
  For Each oDTP In Me.DTPickers
    Set oDTP.DataSource = adoPrimaryRS
  Next

  
  
  Set DataGrid2.DataSource = adoPrimaryRS
  
  Set Combo1.DataSource = adoPrimaryRS
  Set Combo2.DataSource = adoPrimaryRS
  
  
  Set Check1.DataSource = adoPrimaryRS
  Set Check2.DataSource = adoPrimaryRS
  Set Check3.DataSource = adoPrimaryRS
  
  mbDataChanged = False
  
  Combo1.AddItem "入职培训"
  Combo1.AddItem "在职培训"
  Combo1.AddItem "脱产学习"
  Combo1.AddItem "业余学习"
  
  Combo2.AddItem "全员"
  Combo2.AddItem "骨干"
  Combo2.AddItem "特殊人才"
  Combo2.AddItem "管理人员"
  'pxy add 99/6/2
 If GANGWEI = "总经理" Then
  
        Sql = "select * from 工作联络单 where 编号=" & LLDBH & ""
        Set RS = ConnWZ.Execute(Sql)
        For Each oText In Me.txtFields
            Set oText.DataSource = Adodc1
        Next
        jhbh = RS("公文编号")
        Adodc1.RecordSource = "select * from 部门培训计划登记 where 培训计划编号='" & jhbh & "'"
        Adodc1.Refresh
        txtFields(25).Enabled = True
        txtFields(25).Locked = False
End If
Dim i As Integer
For i = 0 To 5
    Me.DTPickers(i).Value = Format(Now, "yyyy年mm月dd日")
Next i
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
  On Error GoTo 0
  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
  On Error GoTo 0
  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
  On Error GoTo 0
  Exit Sub
RefreshErr:
   MsgBox "刷新操作有错误", vbExclamation + vbOKOnly, pTitle
End Sub

Private Sub cmdedit_Click()
  On Error GoTo EditErr
  mbEditFlag = True
  SetButtons False
  
  On Error GoTo 0
  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, "提示"
    Sql = "insert 工作联络单 (发件人,发件人地址,收件人,发件时间,公文类别,阅读状态,是否审批,审批状态,公文编号) values('" & YGXM & "','" & YJBM & "','危红英','" & Now & "','培训','未阅读','是','已审批'," & Val(txtFields(20)) & ")"
    Set RS = ConnWZ.Execute(Sql)
  Else
    MsgBox "数据保存失败！", vbExclamation + vbOKOnly, "警告"
  End If
End Sub

Private Sub cmdClose_Click()
    If GANGWEI <> "总经理" Then
        RSGL.Enabled = True
        Unload Me
      Else
        FRM_ZJLCX.Enabled = True
        Unload Me
    End If
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
  
  Combo1.Enabled = Not bVal
  Combo2.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(11).Text) And IsNumeric(txtFields(12).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(18) = CDbl(txtFields(11)) + CDbl(txtFields(12)) + CDbl(txtFields(13)) + CDbl(txtFields(14)) + CDbl(txtFields(15)) + CDbl(txtFields(16)) + CDbl(txtFields(17))
  End If
  
End Sub

Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then '
    SendKeys "{TAB}"
End If
End Sub

Private Sub txtFields_LostFocus(Index As Integer)
Select Case Index

Case 20

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

Case 5
    If Not IsNumeric(txtFields(5).Text) And (txtFields(5).Text <> "") Then
        MsgBox "请在“参加人数”中输入数字", vbExclamation + vbOKOnly, pTitle
         txtFields(5).SetFocus
         txtFields(5).SelStart = 0
         txtFields(5).SelLength = Len(txtFields(5))
        Exit Sub
    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 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
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
End Select

txtFields(20).Locked = True

End Sub