f_laobaofafangmingdan.frm

人力资源

               TabIndex        =   3
               Top             =   960
               Width           =   1815
            End
            Begin VB.Label lblLabels 
               Caption         =   "通知单编号:"
               Height          =   255
               Index           =   5
               Left            =   240
               TabIndex        =   25
               Top             =   480
               Width           =   975
            End
            Begin VB.Label lblLabels 
               Caption         =   "员工号:"
               Height          =   255
               Index           =   0
               Left            =   3360
               TabIndex        =   11
               Top             =   480
               Width           =   735
            End
            Begin VB.Label lblLabels 
               Caption         =   "姓名:"
               Height          =   255
               Index           =   1
               Left            =   6240
               TabIndex        =   10
               Top             =   480
               Width           =   615
            End
            Begin VB.Label lblLabels 
               Caption         =   "部门:"
               Height          =   255
               Index           =   2
               Left            =   240
               TabIndex        =   9
               Top             =   960
               Width           =   615
            End
            Begin VB.Label lblLabels 
               Caption         =   "岗位:"
               Height          =   255
               Index           =   3
               Left            =   3360
               TabIndex        =   8
               Top             =   960
               Width           =   735
            End
            Begin VB.Label lblLabels 
               Caption         =   "领用时间:"
               Height          =   255
               Index           =   4
               Left            =   6240
               TabIndex        =   7
               Top             =   960
               Width           =   735
            End
         End
      End
   End
End
Attribute VB_Name = "F_LaoBaoFaFangMingDan"
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 Not 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 Form_Load()
On Error Resume Next
    For Each TextBox In Me.Controls
        TextBox.Font.Name = "宋体"
        TextBox.Font.Size = 9
    Next

SetButtons True

'Set adoPrimaryRS = New Recordset
' adoPrimaryRS.Open "SHAPE {通知单编号,员工号,姓名,部门,岗位,领用时间  from 劳保发放名单} AS ParentCMD APPEND ({劳保发放通知单编号,劳保物品名称,数量,单价,金额,使用年限,更换时间 from 劳保发放明细 } AS ChildCMD RELATE 通知单编号 TO 劳保发放通知单编号) AS ChildCMD", db1, adOpenStatic, adLockBatchOptimistic
 
 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
  For Each oText In Me.txtFields
    Set oText.DataSource = adoPrimaryRS
  Next
  
  Set DTPicker1.DataSource = adoPrimaryRS
  
  If adoPrimaryRS.RecordCount <> 0 Then
     Set grdDataGrid.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

  
 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 grdDataGrid_Error(ByVal DataError As Integer, Response As Integer)
    Response = 0
    MsgBox "输入数据不合法，请输入合法数据！", vbExclamation + vbOKOnly, pTitle
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
  If Not bVal Then
     If mbEditFlag Then
      grdDataGrid.AllowAddNew = True
      grdDataGrid.AllowDelete = True
      grdDataGrid.AllowUpdate = True
     End If
  Else
      grdDataGrid.AllowAddNew = False
      grdDataGrid.AllowDelete = False
      grdDataGrid.AllowUpdate = False
  End If
   If bVal Then
   Set DataGrid1.DataSource = adoPrimaryRS
  Else
   Set DataGrid1.DataSource = Nothing
  End If
  
 
 
  DTPicker1.Enabled = Not bVal
  DTPicker1.Enabled = Not bVal
  
End Sub

Private Sub txtFields_LostFocus(Index As Integer)
If Not IsNull(Trim(txtFields(4).Text)) And Index = 4 Then
   txtFields(4).Locked = True
End If

If Index = 0 Then
   Dim Sql3 As String

 
    Sql3 = "select  distinct 部门 ,姓名 ,岗位    from 员工基本信息  where 员工号 = '" & txtFields(0).Text & "'"
    Set rs3 = db.Execute(Sql3)
    
    If Not rs3.EOF Then
   
      If Not IsNull(rs3("部门")) Then
          txtFields(2).Text = Trim(rs3("部门"))
      End If

      If Not IsNull(rs3("姓名")) Then
          txtFields(1).Text = Trim(rs3("姓名"))
      End If
   
      If Not IsNull(rs3("岗位")) Then
          txtFields(3).Text = Trim(rs3("岗位"))
      End If
      
    End If

End If


'If Not IsNumeric(txtFields(6).Text) And (txtFields(6).Text <> "") Then
 '   MsgBox "请在“使用年限”中输入数字", vbExclamation + vbOKOnly, Ptitle
  '   txtFields(6).SetFocus
   '  txtFields(6).SelLength = Len(txtFields(6))
    ' txtFields(6).SelStart = 0
'End If

'If Not IsNumeric(txtFields(8).Text) And (txtFields(8).Text <> "") Then
 '   MsgBox "请在“数量”中输入数字", vbExclamation + vbOKOnly, Ptitle
  '   txtFields(8).SetFocus
   '  txtFields(8).SelLength = Len(txtFields(8))
    ' txtFields(8).SelStart = 0
'End If

'If Not IsNumeric(txtFields(9).Text) And (txtFields(9).Text <> "") Then
 '   MsgBox "请在“单价”中输入数字", vbExclamation + vbOKOnly, Ptitle
   '  txtFields(9).SetFocus
    ' txtFields(9).SelLength = Len(txtFields(9))
     'txtFields(9).SelStart = 0
'End If



End Sub