⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmrgzdj.frm

📁 企业工资管理系统的具体实现
💻 FRM
📖 第 1 页 / 共 2 页
字号:
🔍
12 
         TabIndex        =   7
         Top             =   1290
         Width           =   180
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "月"
         Height          =   180
         Left            =   5655
         TabIndex        =   5
         Top             =   1290
         Width           =   180
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "年"
         Height          =   180
         Left            =   4800
         TabIndex        =   3
         Top             =   1290
         Width           =   180
      End
   End
End
Attribute VB_Name = "frmrgzdj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Check2_Click()
If Check2.Value = 1 Then
    Text4.Enabled = True
Else
    Text4.Enabled = False
End If
End Sub

Private Sub Check3_Click()
If Check3.Value = 1 Then
    Text5.Enabled = True
Else
    Text5.Enabled = False
End If
End Sub

Private Sub Check4_Click()
End Sub

Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub cmdok_Click()
Dim cnn As New ADODB.Recordset
Dim cp As String
Dim record As Integer
record = 0
If cmdok.Caption = "登  记" Then
    If MsgBox("请确认你的日期是否正确，确认请按“是”，否则按“否”", vbYesNo + vbInformation, "提示") = vbYes Then
        s = Val(Trim(Text2.Text))
        If (Val(Trim(Text2.Text)) < 1 Or Val(Trim(Text2.Text)) > 12) Or IsNumeric(Trim(Text2.Text)) = False Then
            MsgBox "月份输入有误，请重输。", vbInformation, "提示"
            Text2.Text = ""
            Text2.SetFocus
            Exit Sub
        ElseIf Val(Trim(Text3.Text)) < 1 Or Val(Trim(Text3.Text)) > 31 Or IsNumeric(Trim(Text3.Text)) = False Then
            MsgBox "日期输入有误，请重输。", vbInformation, "提示"
            Text3.Text = ""
            Text3.SetFocus
            Exit Sub
        End If
        If Combo1.Text = "" Then
            MsgBox "请先进行车间分配后再进行登记！", vbInformation, "提示"
            Unload Me
            frmcjsz.Show
            Exit Sub
        Else
        If Combo2.Text = "" Then
            MsgBox "你没有选择班次！", vbInformation, "提示"
            Exit Sub
        End If
        cp = "cp" & Trim(Str$(Text3.Text)) & " as 产品件数"
        sql = "select cjdh as 车间代号,grdh as 工人代号,xm as 姓名,bc" & Trim(Text3.Text) & " as " & Trim(Text3.Text) & "日," & cp & " from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Trim(Combo1.Text) & "'"
        If Check2.Value = 1 And Check3.Value = 0 Then
            sql = sql & "and grdh='" & Trim(Text4.Text) & "'"         '根据车间代号和工人代号查
        ElseIf Check3.Value = 1 And Check2.Value = 0 Then
            sql = sql & "and xm='" & Trim(Text5.Text) & "'"           '根据车间代号和姓名查
        ElseIf Check2.Value = 1 And Check3.Value = 1 Then
            sql = sql & "and grdh='" & Trim(Text4.Text) & "' and xm='" & Trim(Text5.Text) & "'"
        End If
        With cnn
            .ActiveConnection = constr
            .CursorLocation = adUseClient
            .CursorType = adOpenDynamic
            .LockType = adLockPessimistic
            If Check2.Value = 1 And Check3 = 0 Then
                .Open "select * from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Trim(Combo1.Text) & "' and grdh='" & Trim(Text4.Text) & "'"
            ElseIf Check3.Value = 1 And Check2.Value = 0 Then
                .Open "select * from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Trim(Combo1.Text) & "' and xm='" & Trim(Text5.Text) & "'"
            ElseIf Check2.Value = 1 And Check3.Value = 1 Then
                .Open "select * from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Trim(Combo1.Text) & "' and grdh='" & Trim(Text4.Text) & "' and xm='" & Trim(Text5.Text) & "'"
            Else
                .Open "select * from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Trim(Combo1.Text) & "'"
            End If
            If Not (.EOF And .BOF) Then .MoveFirst
            Do While Not .EOF
                If Not IsNull(.Fields("bc" & Trim(Text3.Text)).Value) Then
                    If MsgBox("此车间的工人已进行过登记，请想重新登记吗？", vbYesNo + vbInformation, "提示") = vbYes Then
                        record = 1         '等于1表示已进行过登记
                        Exit Do
                    Else
                        Exit Sub
                    End If
                record = 0
                End If
                .MoveNext
            Loop
            If record = 1 Then
                .MoveFirst
                Do While Not .EOF                       '循环已登记的工人记录
                    If Len(.Fields("bc" & Trim(Text3.Text)).Value) = 2 Then
                            !cx = !cx - 1
                    ElseIf Len(.Fields("bc" & Trim(Text3.Text)).Value) = 6 Then
                        !cx = !cx - 1.5
                    End If
                    !cpjs = !cpjs - .Fields("cp" & Trim(Text3.Text)).Value
                    .Fields("bc" & Trim(Text3.Text)).Value = Null
                    .Fields("cp" & Trim(Text3.Text)).Value = 0
                    .Update
'                        .Fields.Refresh
                    .MoveNext
                Loop
            End If
            .Close
            End With
            Set cnn = Nothing
        With Adodc2
            .ConnectionString = constr
            .RecordSource = sql
            .Refresh
            If .Recordset.EOF And .Recordset.BOF Then
                MsgBox "没有找到符合条件的工人，你不能进行工作登记！", vbExclamation, "警告"
                Exit Sub
            Else
                .Recordset.MoveFirst
            End If
            Do While Not .Recordset.EOF
                .Recordset.Fields(Trim(Text3.Text) & "日").Value = Trim(Combo2.Text)
                .Recordset.MoveNext
            Loop
        End With
            Set datagrfp.DataSource = Adodc2
            cmdrecord.Enabled = False
            cmdexit.Enabled = False
            Check2.Enabled = False
            Check3.Enabled = False
            Combo1.Enabled = False
            Combo2.Enabled = False
            cmdok.Caption = "确  定"
            datagrfp.AllowUpdate = True
        End If
    Else
        Exit Sub
    End If
Else
    If MsgBox("请检查无误后再确定！", vbOKCancel + vbInformation, "提示") = vbOK Then
        Check2.Enabled = True
        Check3.Enabled = True
        Combo1.Enabled = True
        Combo2.Enabled = True
        With cnn
            .ActiveConnection = constr
            .CursorLocation = adUseClient
            .CursorType = adOpenDynamic
            .LockType = adLockPessimistic
            If Check2.Value = 1 And Check3 = 0 Then
                .Open "select * from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Trim(Combo1.Text) & "' and grdh='" & Trim(Text4.Text) & "'"
            ElseIf Check3.Value = 1 And Check2.Value = 0 Then
                .Open "select * from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Trim(Combo1.Text) & "' and xm='" & Trim(Text5.Text) & "'"
            ElseIf Check2.Value = 1 And Check3.Value = 1 Then
                .Open "select * from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Trim(Combo1.Text) & "' and grdh='" & Trim(Text4.Text) & "' and xm='" & Trim(Text5.Text) & "'"
            Else
                .Open "select * from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Trim(Combo1.Text) & "'"
            End If
            If Not (.EOF And .BOF) Then .MoveFirst
            Do While Not .EOF
                If IsNull(.Fields("cx").Value) Then
                    If Len(Trim(Combo2.Text)) = 2 Then             '表中如果没记录，直接加上班次数
                        .Fields("cx").Value = 1
                    ElseIf Len(Trim(Combo2.Text)) = 6 Then         '2表示一班，6表示一班半
                        .Fields("cx").Value = 1.5
                    End If
                Else
                    If Len(Trim(Combo2.Text)) = 2 Then             '表中如有记录，在原来的基础上加本次上班情况
                        .Fields("cx").Value = .Fields("cx").Value + 1
                    ElseIf Len(Trim(Combo2.Text)) = 6 Then
                        .Fields("cx").Value = .Fields("cx").Value + 1.5
                    End If
                End If
                If IsNull(.Fields("cpjs").Value) Then               '表中加入新产品件数
                    .Fields("cpjs").Value = .Fields("cpjs" & Trim(Text3.Text)).Value
                Else
                    .Fields("cpjs").Value = .Fields("cpjs").Value + .Fields("cp" & Trim(Text3.Text)).Value
                End If
                .MoveNext
            Loop
            .Close
        End With
        Set cnn = Nothing
        cmdrecord.Enabled = True
        cmdexit.Enabled = True
        cmdok.Caption = "登  记"
        datagrfp.AllowUpdate = False
    Else
        Exit Sub
    End If
End If
End Sub

Private Sub cmdrecord_Click()
frmqtdj.Show 1
End Sub

Private Sub Combo1_Click()
Dim grbc As String
grbc = ""
For i = 1 To Val(Trim(Text3.Text))
    grbc = grbc & "bc" & Trim(Str$(i)) & " as " & Trim(Str$(i)) & "日,"
Next i
grbc = Left(Trim(grbc), Len(grbc) - 1)
With Adodc2
    .ConnectionString = constr
    .RecordSource = "select cjdh as 车间代号,grdh as 工人代号,xm as 姓名," & grbc & " from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Combo1.Text & "'"
    .Refresh
End With
Set datagrfp.DataSource = Adodc2
End Sub

Private Sub Form_Load()
Dim grbc As String, year1 As String
Dim i As Integer
grbc = ""
'With Adodc1
'    .ConnectionString = constr
'    .RecordSource = "select * from cjb"
'    .Refresh
'    If Not (.Recordset.EOF And .Recordset.BOF) Then
'        .Recordset.MoveFirst
'    Else
'        MsgBox "请先进行车间设置！", vbInformation, "提示"
'    End If
'    Do While Not .Recordset.EOF
'        Combo1.AddItem .Recordset.Fields("cjdh").Value
'        .Recordset.MoveNext
'    Loop
'End With
'Combo1.Text = Combo1.List(0)
Call frmwork(frmrgzdj)
year1 = Now
v = Split(year1, "-")               '根据“-”分离年月日
'Text1.Text = "20" & v(0)            '年加上后变成四位
Text1.Text = v(0)
If Len(v(1)) = 1 Then
    Text2.Text = "0" & v(1)         '月小于10的前面加0
Else
    Text2.Text = v(1)
End If
v1 = Split(v(2))                    '得到日
Text3.Text = v1(0)
For i = 1 To Val(Trim(v1(0)))
    grbc = grbc & "bc" & Trim(Str$(i)) & " as " & Trim(Str$(i)) & "日,"
Next i
grbc = Left(Trim(grbc), Len(grbc) - 1)
With Adodc2
    .ConnectionString = constr
    .RecordSource = "select cjdh as 车间代号,grdh as 工人代号,xm as 姓名," & grbc & " from sbqkb" & Trim(Text2.Text) & " where cjdh='" & Combo1.Text & "'"
    .Refresh
End With
Set datagrfp.DataSource = Adodc2
End Sub
Private Sub Text1_LostFocus()
If IsNumeric(Text1.Text) = False Then
    MsgBox "输入年份不是数字，请重输。", vbInformation, "提示"
    Text1.Text = ""
    Text1.SetFocus
    Exit Sub
ElseIf Val(Trim(Text1.Text)) < 2000 Or Len(Trim(Text1.Text)) <> 4 Then
    MsgBox "输入的年份格式不对或不是2000年以后，请重输。", vbInformation, "提示"
    Text1.Text = ""
    Text1.SetFocus
    Exit Sub
End If
End Sub

Private Sub Text2_LostFocus()
If IsNumeric(Text2.Text) = False Then
    MsgBox "输入的月份不是数字，请重输。", vbInformation, "提示"
    Text2.Text = ""
    Text2.SetFocus
    Exit Sub
ElseIf Val(Trim(Text2.Text)) < 1 Or Val(Trim(Text2.Text)) > 12 Or Len(Trim(Text2.Text)) <> 2 Then
    MsgBox "输入的月份格式不对（格式：“06”形式）或不在1-12之间，请重输。", vbInformation, "提示"
    Text2.Text = ""
    Text2.SetFocus
    Exit Sub
End If
End Sub

Private Sub Text3_LostFocus()
If IsNumeric(Text3.Text) = False Then
    MsgBox "输入的月份不是数字，请重输。", vbInformation, "提示"
    Text3.Text = ""
    Text3.SetFocus
    Exit Sub
ElseIf Val(Trim(Text3.Text)) < 1 Or Val(Trim(Text3.Text)) > 31 Then
    MsgBox "输入的日期不在1-31之间，请重输。", vbInformation, "提示"
    Text3.Text = ""
    Text3.SetFocus
    Exit Sub
End If
End Sub
12

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -