frmcheckinfo.frm

这是本人用vb配合access数据库开发的一个部门人事管理的一个小软件的源码。

      Index           =   0
      Left            =   360
      TabIndex        =   3
      Top             =   240
      Width           =   735
   End
End
Attribute VB_Name = "frmCheckinfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Public mrc As ADODB.Recordset
Dim mrc As ADODB.Recordset
Public txtSQL As String
Public MsgText As String
Dim mblChange As Boolean
Public colnum As Integer
Public rownum As Integer

Private Sub cboItem_Click(Index As Integer)
    Dim sSql As String
    Dim MsgText As String
    
    If gintMode = 1 Then
        '初始化员工名称和ID
        txtSQL = "select Em_id,Em_dept from EmployeeTable where Em_name='" & Trim(cboItem(0)) & "'"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
        If Index = 0 Then
            cboItem(1).Clear
            
            If Not mrc.EOF Then
                With cboItem(1)
                    Do While Not mrc.EOF
                        .AddItem Trim(mrc!Em_dept)
                        mrc.MoveNext
                    Loop
                    .ListIndex = 0
                End With
                cmdSave.Enabled = True
            Else
                MsgBox "请先建立员工档案！", vbOKOnly + vbExclamation, "警告"
                cmdSave.Enabled = False
                Exit Sub
            End If
        ElseIf Index = 1 Then
            mrc.MoveFirst
            mrc.Move cboItem(1).ListIndex
            txtId = Trim(mrc!Em_id)
            
        End If
    End If
   
End Sub

Private Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub

Private Sub cmdExit_Click()
    If mblChange And gintMode <> 3 And cmdSave.Enabled Then
        If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            '保存
            Call cmdSave_Click
        End If
    End If
    Unload Me
End Sub

Private Sub cmdSave_Click()
    Dim intCount As Integer
    Dim sMeg As String
    Dim recTemp As Recordset
    Dim sSql As String
    Dim MsgText As String
    Dim i As Integer
   
 '   For intCount = 0 To 3
 '       If Trim(txtItem(intCount) & " ") = "" Then
 '           Select Case intCount
 '               Case 0
 '                   sMeg = "本月天数"
 '               Case 2
 '                   sMeg = "应出勤天数"
    
 '              Case 3
 '                   sMeg = "出勤"
 '           End Select
 '           If intCount <> 1 Then
 '               sMeg = sMeg & "不能为空！"
  '              MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
 '               txtItem(intCount).SetFocus
 '               Exit Sub
 '           End If
 '       End If
 '   Next intCount
    
    '添加判断是否有相同的ID记录
    If gintMode = 1 Then
       txtSQL = "select * from EmployeeCheckTable where Em_id='" & Trim(cboItem(0)) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        If mrc.EOF = False Then
            MsgBox "已经存在该员工在该月的考勤记录！", vbOKOnly + vbExclamation, "警告"
         '   cboMonth.SetFocus
            Exit Sub
        End If
        mrc.Close
    End If
        
    
    '先删除已有记录
     txtSQL = "delete from EmployeeCheckTable where Em_id='" & Trim(cboItem(0)) & "'"
     Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    '再加入新记录
    txtSQL = "select * from EmployeeCheckTable"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    For i = 1 To msgList.Rows - 1
        mrc.AddNew
        
        mrc.Fields(0) = Trim(cboItem(0))
        mrc.Fields(1) = Trim(cboItem(1))
        
        mrc.Fields(2) = msgList.TextMatrix(i, 0)
        
       
        mrc.Fields(3) = Val(msgList.TextMatrix(i, 1))
        
        
      ' mrc.Fields(2) = Format(cboYear & "-" & cboMonth & "-01", "yyyy-mm-dd")
    
        For intCount = 0 To 3
            mrc.Fields(intCount + 4) = Val(Trim(txtItem(intCount).Text))
        Next intCount
        mrc.Update
    Next i
     
    
    
    If gintMode = 1 Then
        MsgBox "记录添加成功！", vbOKOnly + vbExclamation, "警告"
        
        
          '刷新
        
        frmCheckinfo.txtItem(0).Text = ""
        frmCheckinfo.txtItem(1).Text = ""
        frmCheckinfo.txtItem(2).Text = ""
        frmCheckinfo.txtItem(3).Text = ""
        frmCheckinfo.Text1.Text = ""
        For i = 1 To frmCheckinfo.msgList.Rows - 1
    
             frmCheckinfo.msgList.TextMatrix(i, 1) = ""
              
        Next i
        
        
        frmCheckinfo.Show
        frmCheckinfo.ZOrder 0
        frmCheck.ShowTitle
        frmCheck.txtSQL = "select * from EmployeeCheckTable"
        frmCheck.Showdata
        frmCheck.ZOrder 1
        
    Else
        MsgBox "记录修改成功！", vbOKOnly + vbExclamation, "警告"
        Unload Me
        frmCheck.ShowTitle
        frmCheck.txtSQL = "select * from EmployeeCheckTable"
        frmCheck.Showdata
        frmCheck.ZOrder 0
    End If
    
    gintMode = 0
    
End Sub



Private Sub Form_Load()
    
    Dim intCount As Integer
    Dim dateTemp As Date
    Dim MsgText As String
    Dim i As Integer
    Dim j As Integer
   
    
    
    
    ShowTitle
    'Showdata

    
    If gintMode = 1 Then
        Me.Caption = Me.Caption & "Input"
        
        
        
        
        '初始化员工信息
        txtSQL = "select Em_name from EmployeeTable"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
            
                Do While Not mrc.EOF
                    cboItem(0).AddItem Trim(mrc!Em_name)
                    mrc.MoveNext
                Loop
                cboItem(0).ListIndex = 0
            
        Else
            MsgBox "请先进行员工档案登记！", vbOKOnly + vbExclamation, "警告"
            cmdSave.Enabled = False
            Exit Sub
        End If
        
        mrc.Close
        
        
        txtSQL = "select * from BaseCheckTable"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        Label2.Caption = "Note:" & "   The base work time of " & mrc.Fields(0) & " is " & mrc.Fields(1) & "days*8h" & " = " & mrc.Fields(2) & " hours"
        
        mrc.Close
        
        
        '初始化部门名称
     '   txtSQL = "select Em_dept from EmployeeTable"
     '   Set mrc = ExecuteSQL(txtSQL, MsgText)
        
     '   If Not mrc.EOF Then
            
     '           Do While Not mrc.EOF
     '               cboItem(1).AddItem Trim(mrc!Em_dept)
     '               mrc.MoveNext
     '           Loop
     '           cboItem(1).ListIndex = 0
            
    '    Else
      '      MsgBox "请先进行部门档案登记！", vbOKOnly + vbExclamation, "警告"
      '      cmdSave.Enabled = False
      '      Exit Sub
     '   End If
         
       
        '初始化项目名称
      '  txtSQL = "select Pro_name from ProjectTable"
      '  Set mrc = ExecuteSQL(txtSQL, MsgText)
        
      '  If Not mrc.EOF Then
            
       '         Do While Not mrc.EOF
       '             cboItem(2).AddItem Trim(mrc!Pro_name)
       '             mrc.MoveNext
       '         Loop
       '         cboItem(2).ListIndex = 0
            
      '  Else
      '      MsgBox "请先进行项目档案登记！", vbOKOnly + vbExclamation, "警告"
      '      cmdSave.Enabled = False
      '      Exit Sub
     '   End If
        
        '初始化本月天数
      '  dateTemp = DateAdd("d", -1, DateAdd("m", 1, DateSerial(CInt(cboYear), CInt(cboMonth), 1)))
      '  txtItem(0) = Day(dateTemp)
      '  mrc.Close
    ElseIf gintMode = 2 Then
        
        frmCheckinfo.txtSQL = "select * from EmployeeCheckTable where Em_id='" & Trim(frmCheck.msgList.TextMatrix(frmCheck.msgList.Row, 1)) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If mrc.EOF = False Then
            With mrc
                cboItem(0).AddItem .Fields(0)
                cboItem(0).ListIndex = 0
                
                cboItem(1).AddItem .Fields(1)
                cboItem(1).ListIndex = 0
                
                
                
  
                For intCount = 0 To 3
                    If Not IsNull(.Fields(intCount)) Then
                        txtItem(intCount).Text = mrc.Fields(intCount + 4)
                       
                    End If
                Next intCount
                
                For i = 0 To mrc.RecordCount - 1
                
                For j = 1 To frmCheckinfo.msgList.Rows - 1
                    
                    If frmCheckinfo.msgList.TextMatrix(j, 0) = mrc.Fields(2) Then
                    frmCheckinfo.msgList.TextMatrix(j, 1) = mrc.Fields(3)
                    End If
                    
                Next j
                mrc.MoveNext
                Next i
                
                    
                    
                
             '   txtItem(7) = .Fields(6)
            '    txtItem(8) = .Fields(7)
         '       txtId = .Fields(0)
            End With
        End If
        mrc.Close
        
        txtSQL = "select * from BaseCheckTable"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        Label2.Caption = "Note:" & "   The base work time of " & mrc.Fields(0) & " is " & mrc.Fields(1) & " days*8h " & " = " & mrc.Fields(2) & " hours"
        
        mrc.Close
        
   '     txtSQL = "select  Em_dept from EmployeeTable where Em_name = '" & Trim(cboItem(1)) & "'"
    '    Set mrc = ExecuteSQL(txtSQL, MsgText)
    '    cboItem(0).AddItem Trim(mrc!Em_dept)
   '     cboItem(0).ListIndex = 0
   '     mrc.Close
        
        Me.Caption = Me.Caption & "Modify"
    End If
    
    mblChange = False
    
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)

Dim t04 As Integer

Dim i As Integer


    Select Case KeyCode
        
        Case 38 '光标向上
            
           ' If t04 < 11 Then
            '    If msgList.Row > 1 Then