frmcheck1.frm

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

   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   6000
      TabIndex        =   11
      Top             =   5520
      Width           =   1215
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "Save (&S)"
      Height          =   375
      Left            =   4440
      TabIndex        =   10
      Top             =   5520
      Width           =   1215
   End
End
Attribute VB_Name = "frmCheck1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'是否改动过记录，ture为改过
Dim mblChange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As String

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 cboMonth_Click()
'    Dim dateTemp As Date
    
'    dateTemp = DateAdd("d", -1, DateAdd("m", 1, DateSerial(CInt(cboYear), CInt(cboMonth), 1)))
'    txtItem(0) = Day(dateTemp)
End Sub



Private Sub cboYear_Click()
'    Dim dateTemp As Date
    
'    If Trim(cboMonth & " ") <> "" Then
'        dateTemp = DateAdd("d", -1, DateAdd("m", 1, DateSerial(CInt(cboYear), CInt(cboMonth), 1)))
'        txtItem(0) = Day(dateTemp)
'    End If
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
   
 '   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(txtId) & "'"
        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(txtId) & "'"
   ' Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    '再加入新记录
    txtSQL = "select * from EmployeeCheckTable"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(cboItem(0))
    mrc.Fields(1) = Trim(cboItem(1))
    mrc.Fields(2) = Trim(cboItem(2))
   ' mrc.Fields(2) = Format(cboYear & "-" & cboMonth & "-01", "yyyy-mm-dd")
    
    For intCount = 0 To 5
        mrc.Fields(intCount + 3) = Trim(txtItem(intCount + 3).Text)
    Next intCount
    
      
    mrc.Update
    
    If gintMode = 1 Then
        MsgBox "记录添加成功！", vbOKOnly + vbExclamation, "警告"
        
        
        For intCount = 0 To 8
            txtItem(intCount).Text = ""
            mblChange = False
        Next intCount
        
        
        frmCheck1.Show
        frmCheck1.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
    
    
      
  '  cboYear.AddItem Year(Now)
  '  cboYear.AddItem Year(Now) - 1
  '  cboYear.ListIndex = 0
    
 '   For intCount = 1 To 12
 '       cboMonth.AddItem intCount
 '   Next intCount
 '   cboMonth = Month(Now)
    
    If gintMode = 1 Then
        Me.Caption = Me.Caption & "添加"
        
        '初始化员工信息
        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
        
        '初始化部门名称
     '   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
        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
                
  '              cboItem(2).AddItem .Fields(2)
  '              cboItem(2).ListIndex = 0
                For intCount = 3 To 6
                    If Not IsNull(.Fields(intCount)) Then
                        txtItem(intCount + 1) = .Fields(intCount)
                    End If
                Next intCount
             '   txtItem(7) = .Fields(6)
            '    txtItem(8) = .Fields(7)
                txtId = .Fields(0)
            End With
        End If
        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 & "修改"
    End If
    
    mblChange = False
End Sub

Private Sub txtItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True
End Sub

Private Sub txtItem_GotFocus(Index As Integer)
    txtItem(Index).SelStart = 0
    txtItem(Index).SelLength = Len(txtItem(Index))
End Sub

Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    
    EnterToTab KeyCode

    
End Sub

Private Function GetNo() As String
    GetNo = Format(Now, "yymmddhhmmss")
    Randomize
    GetNo = GetNo & Int((99 - 10 + 1) * Rnd + 10)
End Function

Private Sub txtItem_KeyPress(Index As Integer, KeyAscii As Integer)
    
    If Index >= 0 And Index <= 8 Then
        'MsgBox KeyCode
        '对键入字符进行控制
        'txtQuantity(Index).Locked = False
        '小数点只允许输入一次
        If KeyAscii = 190 Then
            If InStr(Trim(txtItem(Index)), ".") = 0 Then
                If Len(Trim(txtItem(Index))) > 0 Then
                    txtItem(Index).Locked = False
               Else
                   txtItem(Index).Locked = True
                End If
            Else
               txtItem(Index).Locked = True
            End If
            Exit Sub
        End If
        '非数字不能输入
        If KeyAscii > 57 Or KeyAscii < 48 Then
            txtItem(Index).Locked = True
        Else
            txtItem(Index).Locked = False
        End If
        '允许Backspace
        If KeyAscii = 8 Then
            txtItem(Index).Locked = False
        End If
        'Delete键
        If KeyAscii = 46 Then
            txtItem(Index).Locked = False
        End If
    End If
    
End Sub