?? 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 "數據保存失?。?quot;, 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -