?? f_peixunxiangmushishi.frm

?? 20060514.rar
?? FRM
?? 第 1 頁 / 共 4 頁
字號:
上一頁 1 2 34
  
  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
上一頁 1 2 34
?? 文件大小 640 K
?? 上傳用戶 zxc28287176
?? 所屬分類企業管理
??? 相關標簽

#20060514
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? f_peixunxiangmushishi.frm

?? 快捷鍵說明
