frmleaveladd.frm

一套比较完整的VB开发的员工请假管理系统

         AutoSize        =   -1  'True
         Caption         =   "起始时间："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   120
         TabIndex        =   16
         Top             =   960
         Width           =   1050
      End
      Begin VB.Label lblLeavel_end_time 
         AutoSize        =   -1  'True
         Caption         =   "结束时间："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   4560
         TabIndex        =   15
         Top             =   960
         Width           =   1050
      End
      Begin VB.Label lblLeavel_matter 
         AutoSize        =   -1  'True
         Caption         =   "请假事由："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   120
         TabIndex        =   14
         Top             =   1560
         Width           =   1050
      End
   End
   Begin VB.Frame framtop 
      Height          =   735
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   8415
      Begin VB.CommandButton cmdSearchName 
         Appearance      =   0  'Flat
         BackColor       =   &H00FEE4D1&
         Caption         =   "..."
         Height          =   375
         Left            =   5160
         Style           =   1  'Graphical
         TabIndex        =   20
         Top             =   240
         Width           =   495
      End
      Begin MSDataListLib.DataCombo dcbDepartID 
         Height          =   360
         Left            =   6360
         TabIndex        =   6
         Top             =   240
         Width           =   1935
         _ExtentX        =   3413
         _ExtentY        =   635
         _Version        =   393216
         Locked          =   -1  'True
         Text            =   ""
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.TextBox txtEmpName 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Left            =   3480
         TabIndex        =   2
         Top             =   240
         Width           =   1575
      End
      Begin VB.TextBox txtEmpID 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Left            =   1080
         MaxLength       =   8
         TabIndex        =   1
         Top             =   240
         Width           =   1695
      End
      Begin VB.Label lblDepartID 
         AutoSize        =   -1  'True
         Caption         =   "部门:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   5760
         TabIndex        =   5
         Top             =   360
         Width           =   525
      End
      Begin VB.Label lblEmpName 
         AutoSize        =   -1  'True
         Caption         =   "姓名："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   2880
         TabIndex        =   4
         Top             =   360
         Width           =   630
      End
      Begin VB.Label lblEmpId 
         AutoSize        =   -1  'True
         Caption         =   "工作证号："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   120
         TabIndex        =   3
         Top             =   360
         Width           =   1050
      End
   End
End
Attribute VB_Name = "frmLeavelAdd"
Attribute VB_GlobalNameSpace = False
'Download by http://www.codefans.net
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Function RecordSearch(ByVal rctSource As ADODB.Recordset, ByVal FieldName As String, ByVal FieldValue As Variant) As Boolean
    If rctSource.RecordCount > 0 Then
        rctSource.MoveFirst
        
        If rctSource.Fields(FieldName).Type = adBigInt Then
             rctSource.Find (FieldName & " = " & FieldValue)
         Else
            rctSource.Find (FieldName & " = " & "'" & FieldValue & "'")
        End If
        
        If Not (rctSource.BOF Or rctSource.EOF) Then
            RecordSearch = True
        Else
            RecordSearch = False
        End If
    Else
       RecordSearch = False
    End If
End Function
Public Sub InifrmLeavel()
    With rctLeavelList
        If Not (.BOF Or .EOF) Then
           txtEmpID.Text = .Fields("Emp_id")
           txtEmpName.Text = .Fields("Emp_Name")
           If .Fields("Depart_id") <> Empty Then
                dcbDepartID.BoundText = .Fields("Depart_id")
            Else
                dcbDepartID.BoundText = Empty
           End If
           
           
            dcbLeavelStatus.BoundText = .Fields("LS_ID")
        
           
          
            dcbLeavelType.BoundText = .Fields("Leavel_ID")
          
           
           If .Fields("Leavel_start_time") <> Empty Then
               mskLeavel_start_time.Text = Format(.Fields("Leavel_start_time"), "yyyy-mm-dd")
            Else
                mskLeavel_start_time.Text = "    -  -  "
           End If
           
           If .Fields("Leavel_end_time") <> Empty Then
                MaskLeavel_end_time.Text = Format(.Fields("Leavel_end_time"), "yyyy-mm-dd")
           Else
                MaskLeavel_end_time.Text = "    -  -  "
           End If
           
           If .Fields("Leavel_matter") <> Empty Then
                txtLeavel_matter.Text = .Fields("Leavel_matter")
           Else
               txtLeavel_matter.Text = Empty
           End If
           
           If .Fields("Examine_opinion") <> Empty Then
                 txtExamine_opinion.Text = .Fields("Examine_opinion")
           Else
                txtExamine_opinion.Text = Empty
           End If
           
           If .Fields("Examine_person") <> Empty Then
                txtExamine_person.Text = .Fields("Examine_person")
           Else
                 txtExamine_person.Text = Empty
           End If
           
           If .Fields("Leavel_days") <> Empty Then
                txtLeavel_days.Text = .Fields("Leavel_days")
           Else
                txtLeavel_days.Text = Empty
           End If
        End If
    End With
End Sub

Private Sub frmLeavelAddClear()
    txtEmpID.Text = Empty
    txtEmpName.Text = Empty
    dcbDepartID.BoundText = Empty
    dcbLeavelStatus.BoundText = Empty
    dcbLeavelType.BoundText = Empty
    txtLeavel_days.Text = Empty
    mskLeavel_start_time.Text = "    -  -  "
    MaskLeavel_end_time.Text = "    -  -  "
    txtLeavel_matter.Text = Empty
    txtExamine_opinion.Text = Empty
    txtExamine_person.Text = Empty
End Sub

Private Function SaveLeavelListRecords(ByVal rctSource As ADODB.Recordset, ByVal Emp_ID As Variant, ByVal Emp_Name As Variant, ByVal Depart_ID As Variant, ByVal Leavel_start_time As Variant, ByVal Leavel_end_time As Variant, ByVal Leavel_days As Variant, ByVal Leavel_ID As Variant, ByVal Leavel_matter As Variant, ByVal Examine_opinion As Variant, ByVal Examine_person As Variant, ByVal LS_ID As Variant) As Boolean
    With rctSource
    
        On Error GoTo Error_On_Save
            If Emp_ID <> Empty Then
                .Fields("Emp_id") = Emp_ID
            End If
            
            If Emp_Name <> Empty Then
                .Fields("Emp_Name") = Emp_Name
            End If
            
            If Depart_ID <> Empty Then
                .Fields("Depart_ID") = Depart_ID
            End If
            
            If Leavel_start_time <> Empty Then
                .Fields("Leavel_start_time") = Leavel_start_time
            End If
            
            If Leavel_end_time <> Empty Then
                .Fields("Leavel_end_time") = Leavel_end_time
            End If
            
            If Leavel_days <> Empty Then
                .Fields("Leavel_days") = Leavel_days
            End If
            
            If Leavel_ID <> Empty Then
                .Fields("Leavel_ID") = Leavel_ID
            End If
            
            If Leavel_matter <> Empty Then
                .Fields("Leavel_matter") = Leavel_matter
            End If
            
            If Examine_opinion <> Empty Then
                .Fields("Examine_opinion") = Examine_opinion
            End If
            
            If Examine_person <> Empty Then
                .Fields("Examine_person") = Examine_person
            End If
            
            If LS_ID <> Empty Then
                .Fields("LS_ID") = LS_ID
            End If
            
            .Update
            SaveLeavelListRecords = True
            
        Exit Function
        
Error_On_Save:
    
    SaveLeavelListRecords = False
    .CancelUpdate
    
    MsgBox "错误代码:" & Err.Number & vbCrLf & _
           "错误描述:" & Err.Description, vbCritical + vbOKOnly, "保存记录失败"
    End With
End Function

Private Sub cmdCancel_Click()
    Call frmLeavelAddClear
End Sub

Private Sub cmdExit_Click()
 Unload Me
End Sub

Private Sub cmdNext_Click()
    If rctLeavelList.RecordCount > 0 And rctLeavelList.EOF = False Then
        rctLeavelList.MoveNext
    If Not rctLeavelList.EOF Then
         Call InifrmLeavel
    Else
        MsgBox "已经到尾了!", vbInformation + vbOKOnly, "移动记录"
    End If
   
      
    End If