frmqtdj.frm
来自「企业工资管理系统的具体实现」· FRM 代码 · 共 684 行 · 第 1/2 页
FRM
684 行
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 3315
TabIndex = 13
Top = 1590
Width = 1050
End
Begin VB.Label Label6
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 = 195
TabIndex = 11
Top = 1140
Width = 1050
End
Begin VB.Label Label5
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 = 3345
TabIndex = 9
Top = 1155
Width = 1050
End
Begin VB.Label Label4
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 = 195
TabIndex = 7
Top = 720
Width = 1050
End
Begin VB.Label Label1
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 = 2580
TabIndex = 6
Top = 285
Width = 210
End
Begin VB.Label Label2
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 = 3450
TabIndex = 5
Top = 285
Width = 210
End
Begin VB.Label Label3
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 = 4290
TabIndex = 4
Top = 285
Width = 210
End
End
End
Attribute VB_Name = "frmqtdj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error GoTo err1
If MsgBox("请检查日期是否正确，正确请按“是”，否则请修改！", vbInformation + vbYesNo, "提示") = vbNo Then
Exit Sub
ElseIf Text2.Text = "" Then
MsgBox "请输入月份！", vbInformation, "提示"
Text2.SetFocus
Exit Sub
End If
If Text4.Text = "" Then
MsgBox "请输入工人代号！", vbInformation, "提示"
Exit Sub
Else
With Adodc1
.ConnectionString = constr
.RecordSource = "select * from sbqkb01"
.Refresh
If .Recordset.EOF And .Recordset.BOF Then
MsgBox "你还没有进行工作分配，请先进行分配！", vbInformation, "提示"
Unload Me
frmgzfp.Show
Exit Sub
End If
.ConnectionString = constr
.RecordSource = "select cjdh from sbqkb01 where grdh='" & Trim(Text4.Text) & "'"
.Refresh
If Not (.Recordset.EOF And .Recordset.BOF) Then
cjdh = .Recordset.Fields("cjdh").Value
yf = Trim(Text1.Text) & "年" & Trim(Text2.Text) & "月"
With Adodc2
.ConnectionString = constr
.RecordSource = "select * from gzkcb where yf='" & yf & "'and grdh='" & Trim(Text4.Text) & "'"
.Refresh
If (.Recordset.EOF And .Recordset.BOF) Then
.Recordset.AddNew
.Recordset.Fields("yf").Value = yf
.Recordset.Fields("cjdh").Value = cjdh
.Recordset.Fields("grdh").Value = Trim(Text4.Text)
End If
If IsNull(.Recordset.Fields("qx").Value) And Combo1.Text = "是" Then
.Recordset.Fields("qx").Value = 1
ElseIf Combo1.Text = "是" Then
.Recordset.Fields("qx").Value = .Recordset.Fields("qx").Value + 1
End If
If IsNull(.Recordset.Fields("cdsj").Value) Then
.Recordset.Fields("cdsj").Value = Val(Trim(Text5.Text))
ElseIf Text5.Text <> "" Then
.Recordset.Fields("cdsj").Value = .Recordset.Fields("cdsj").Value + Val(Trim(Text5.Text))
End If
If IsNull(.Recordset.Fields("jbsj").Value) Then
.Recordset.Fields("jbsj").Value = Val(Trim(Text9.Text))
ElseIf Text9.Text <> "" Then
.Recordset.Fields("jbsj").Value = .Recordset.Fields("jbsj").Value + Val(Trim(Text9.Text))
End If
If IsNull(.Recordset.Fields("cpkc").Value) Then
.Recordset.Fields("cpkc").Value = Val(Trim(Text6.Text))
ElseIf Text6.Text <> "" Then
.Recordset.Fields("cpkc").Value = .Recordset.Fields("cpkc").Value + Val(Trim(Text6.Text))
End If
If IsNull(.Recordset.Fields("qtkc").Value) Then
.Recordset.Fields("qtkc").Value = Val(Trim(Text7.Text))
ElseIf Text7.Text <> "" Then
.Recordset.Fields("qtkc").Value = .Recordset.Fields("qtkc").Value + Val(Trim(Text7.Text))
End If
If Text8.Text <> "" Then .Recordset.Fields("bz").Value = .Recordset.Fields("bz").Value & Text8.Text
.Recordset.Update
End With
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Combo1.Text = ""
Text4.SetFocus
Else
MsgBox "已分配的车间中没有这个工人，请检查！", vbExclamation, "提示"
Text4.Text = ""
Text4.SetFocus
Exit Sub
End If
End With
End If
err1:
If Err.Number = -2147217887 Then
MsgBox "迟到时间，加班时间，次品时间或其它时间可能过大，请查阅其它登记表。", vbExclamation + vbOKOnly, "提示"
Exit Sub
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim year1 As String
year1 = Now
v = Split(year1, "-")
Text1.Text = v(0)
If Len(v(1)) = 1 Then
Text2.Text = "0" & v(1)
Else
Text2.Text = v(1)
End If
v1 = Split(v(2))
Text3.Text = v1(0)
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
Private Sub Text5_LostFocus()
If IsNumeric(Text5.Text) = False And Text5.Text <> "" Then
MsgBox "输入非数字，请重输入", vbInformation, "提示"
Text5.Text = ""
Text5.SetFocus
End If
If Text5.Text <> "" Then
If Len(Trim(Str$(Text5.Text))) > 3 Then
MsgBox "输入的数字过长，与实际不符，请重输。", vbInformation, "提示"
Text5.Text = ""
Text5.SetFocus
Exit Sub
End If
End If
End Sub
Private Sub Text6_LostFocus()
If IsNumeric(Text6.Text) = False And Text6.Text <> "" Then
MsgBox "输入非数字，请重输入", vbInformation, "提示"
Text6.Text = ""
Text6.SetFocus
End If
If Text6.Text <> "" Then
If Len(Trim(Str$(Text6.Text))) > 4 Then
MsgBox "输入的数字过长，与实际不符，请重输。", vbInformation, "提示"
Text6.Text = ""
Text6.SetFocus
Exit Sub
End If
End If
End Sub
Private Sub Text7_LostFocus()
If IsNumeric(Text7.Text) = False And Text7.Text <> "" Then
MsgBox "输入非数字，请重输入", vbInformation, "提示"
Text7.Text = ""
Text7.SetFocus
End If
If Text7.Text <> "" Then
If Len(Trim(Str$(Text7.Text))) > 4 Then
MsgBox "输入的数字过长，与实际不符，请重输。", vbInformation, "提示"
Text7.Text = ""
Text7.SetFocus
Exit Sub
End If
End If
End Sub
Private Sub Text9_LostFocus()
If IsNumeric(Text9.Text) = False And Text9.Text <> "" Then
MsgBox "输入非数字，请重输入", vbInformation, "提示"
Text9.Text = ""
Text9.SetFocus
End If
If Text9.Text <> "" Then
If Len(Trim(Str$(Text9.Text))) > 3 Then
MsgBox "输入的数字过长，与实际不符，请重输。", vbInformation, "提示"
Text9.Text = ""
Text9.SetFocus
Exit Sub
End If
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?