f_bumenpeixunjihua.frm

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

      Height          =   255
      Index           =   27
      Left            =   120
      TabIndex        =   0
      Top             =   8700
      Width           =   1815
   End
End
Attribute VB_Name = "F_BuMenPeiXunJiHua"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Private Function UpdateData() As Boolean
  Dim strTemp As String
  Dim adochild As ADODB.Recordset
  On Error GoTo UpdateErr
  
  '更新父表
  adoPrimaryRS.UpdateBatch adAffectCurrent
 
  '检查子表的有效性
  Set adochild = New Recordset
  Set adochild = adoPrimaryRS("ChildCMD").UnderlyingValue
  
  If Not (adochild.BOF And adochild.EOF) Then
    adochild.MoveFirst
  End If
  
  'While Not adochild.EOF

      
   '   If Trim(adochild.Fields("单价")) = "" Or IsNull(adochild.Fields("单价")) Or Not IsNumeric(adochild.Fields("单价")) Then
    '     MsgBox "请在单价中输入数字！", vbExclamation + vbOKOnly, "警告"
     '    adochild.Close
         '   Set adochild = Nothing
         'Exit Function
      'End If
      
      'If Trim(adochild.Fields("数量")) = "" Or IsNull(adochild.Fields("数量")) Or Not IsNumeric(adochild.Fields("单价")) Then
         '  MsgBox "请在数量中输入数字！", vbExclamation + vbOKOnly, "警告"
        ' adochild.Close
        ' Set adochild = Nothing
         'Exit Function
     ' End If
      
      
  '    adochild.MoveNext
 ' Wend
  
  '更新子表
  adochild.UpdateBatch adAffectAllChapters
  adochild.Close
  Set adochild = Nothing
  
 ' strTemp = txtFields(0).Text
 ' Set grdDataGrid.DataSource = Nothing
  'adoPrimaryRS.Requery
  'adoPrimaryRS.Find "目的港='" & strTemp & "'", 0, adSearchForward
  'Set grdDataGrid.DataSource = adoPrimaryRS("ChildCMD").UnderlyingValue
 
  UpdateData = True
  
  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_AfterColUpdate(ByVal ColIndex As Integer)
  On Error Resume Next
    If ColIndex = 1 Then
        t = DataGrid1.Row
        DataGrid1.Col = 1
        DataGrid1.Row = t
        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 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
  
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, "提示"
    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_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