frmcheck1.frm

人事管理信息系统

            Left            =   240
            TabIndex        =   35
            Top             =   360
            Width           =   975
         End
         Begin VB.Label Label2 
            Caption         =   "本月天数："
            Height          =   255
            Index           =   3
            Left            =   3240
            TabIndex        =   34
            Top             =   360
            Width           =   975
         End
         Begin VB.Label Label2 
            Caption         =   "公休天数："
            Height          =   255
            Index           =   4
            Left            =   240
            TabIndex        =   33
            Top             =   840
            Width           =   975
         End
         Begin VB.Label Label2 
            Caption         =   "应出勤天数："
            Height          =   255
            Index           =   5
            Left            =   3120
            TabIndex        =   32
            Top             =   840
            Width           =   1095
         End
         Begin VB.Label Label2 
            Caption         =   "年"
            Height          =   255
            Index           =   8
            Left            =   2040
            TabIndex        =   31
            Top             =   360
            Width           =   255
         End
         Begin VB.Label Label2 
            Caption         =   "月"
            Height          =   255
            Index           =   9
            Left            =   2880
            TabIndex        =   30
            Top             =   360
            Width           =   255
         End
      End
      Begin VB.Frame Frame1 
         Caption         =   "员工信息"
         Height          =   855
         Left            =   480
         TabIndex        =   25
         Top             =   600
         Width           =   5415
         Begin VB.ComboBox cboItem 
            Height          =   288
            Index           =   0
            Left            =   960
            Style           =   2  'Dropdown List
            TabIndex        =   0
            Top             =   360
            Width           =   1695
         End
         Begin VB.ComboBox cboItem 
            Height          =   288
            Index           =   1
            Left            =   3480
            Style           =   2  'Dropdown List
            TabIndex        =   1
            Top             =   360
            Width           =   1695
         End
         Begin VB.Label Label2 
            Caption         =   "部  门："
            Height          =   255
            Index           =   0
            Left            =   240
            TabIndex        =   27
            Top             =   360
            Width           =   975
         End
         Begin VB.Label Label2 
            Caption         =   "姓  名："
            Height          =   255
            Index           =   1
            Left            =   2760
            TabIndex        =   26
            Top             =   360
            Width           =   975
         End
      End
   End
   Begin VB.TextBox txtId 
      Height          =   270
      Left            =   1320
      TabIndex        =   23
      TabStop         =   0   'False
      Top             =   4920
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "返回 (&X)"
      Height          =   375
      Left            =   5040
      TabIndex        =   22
      Top             =   4800
      Width           =   1215
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "保存 (&S)"
      Height          =   375
      Left            =   3480
      TabIndex        =   21
      Top             =   4800
      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 ygid,ygname from manrecord where ygdept='" & 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!ygname)
                        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!ygid)
            
        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 checkin where kqid='" & Trim(txtId) & "' and kqdate= '" & Format(cboYear.Text & "-" & cboMonth.Text & "-01", "yyyy-mm-dd") & "'"
        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 checkin where kqid='" & Trim(txtId) & "' and kqdate='" & Format(cboYear & "-" & cboMonth & "-01", "yyyy-mm-dd") & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    '再加入新记录
    txtSQL = "select * from checkin"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(txtId)
    mrc.Fields(1) = Trim(cboItem(1))
    mrc.Fields(2) = Format(cboYear & "-" & cboMonth & "-01", "yyyy-mm-dd")
    
    For intCount = 0 To 15
        mrc.Fields(intCount + 3) = Trim(txtItem(intCount).Text)
    Next intCount
    
    For intCount = 16 To 17
        mrc.Fields(intCount + 3) = Trim(txtItem(intCount).Text)
    Next intCount
    
    mrc.Update
    
    If gintMode = 1 Then
        MsgBox "记录添加成功！", vbOKOnly + vbExclamation, "警告"
        For intCount = 0 To 17
            txtItem(intCount) = ""
        Next intCount
        mblChange = False
        
    ElseIf gintMode = 2 Then
        MsgBox "记录修改成功！", vbOKOnly + vbExclamation, "警告"
        Unload Me
        frmCheck.ShowTitle
        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 DISTINCT ygdept from manrecord"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
            
                Do While Not mrc.EOF
                    cboItem(0).AddItem Trim(mrc!ygdept)
                    mrc.MoveNext
                Loop
                cboItem(0).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(1).AddItem .Fields(1)
                cboItem(1).ListIndex = 0
                For intCount = 2 To 19
                    If Not IsNull(.Fields(intCount)) Then
                        txtItem(intCount - 2) = .Fields(intCount)
                    End If
                Next intCount
                txtId = .Fields(0)
            End With
        End If
        mrc.Close
        
        txtSQL = "select  ygdept from manrecord where ygname = '" & Trim(cboItem(1)) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        cboItem(0).AddItem Trim(mrc!ygdept)
        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 <= 15 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