📄 frm临发生成.frm
字号:
TabIndex = 0
Top = 150
Width = 855
End
Begin VB.Label Label1
Caption = "备注:"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 5
Left = 210
TabIndex = 16
Top = 1590
Width = 675
End
Begin VB.Label Label1
Caption = "发放名称:"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 4
Left = 210
TabIndex = 15
Top = 660
Width = 1215
End
Begin VB.Label Label1
Caption = "人均发放金额:"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 3
Left = 210
TabIndex = 13
Top = 1110
Width = 1665
End
Begin VB.Label Label1
Caption = "日:"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 2
Left = 2970
TabIndex = 12
Top = 210
Width = 435
End
Begin VB.Label Label1
Caption = "月:"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 1
Left = 2070
TabIndex = 11
Top = 210
Width = 405
End
Begin VB.Label Label1
Caption = "发放年:"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 0
Left = 210
TabIndex = 10
Top = 180
Width = 885
End
End
Attribute VB_Name = "Frm临发生成"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click(Index As Integer)
If Index = 0 Then
If Len(Trim(Text1(0).Text)) = 4 And Val(Trim(Text1(0).Text)) >= 1998 And Val(Trim(Text1(0).Text)) <= Year(Date) And Len(Trim(Text1(1).Text)) = 2 And Len(Trim(Text1(2).Text)) = 2 And Len(Trim(Text1(3).Text)) > 0 And Val(Text1(4).Text) > 0 And Val(Text1(1).Text) > 1 And Val(Text1(1).Text) <= 12 And Val(Text1(2).Text) > 1 And Val(Text1(2).Text) <= 31 Then
wtb1.Seek "=", Text1(0).Text, Text1(1).Text, Text1(2).Text, Text1(3).Text
If wtb1.NoMatch Then
wtb1.AddNew
hxfi = 0
Do While hxfi <= 5
wtb1.Fields(hxfi).Value = Text1(hxfi).Text
hxfi = hxfi + 1
Loop
wtb1.Update
wdb.Close
Frame2.Visible = True
PB1.Max = 1
lswjlj = xtlj & "data\" & Trim(Text1(0).Text) & Trim(Text1(1).Text) & Trim(Text1(2).Text) & ".mdb"
FileCopy xtlj & "lfbzk.mdb", lswjlj
Data2.DatabaseName = lswjlj
Data2.RecordSource = "select * from lfbzk"
Data2.Refresh
If Check1(0).Value = 1 Then
Data1.DatabaseName = xtlj & "bzxx.mdb"
SQL = "select * from [zzbzk]"
Data1.RecordSource = SQL
Data1.Refresh
PB1.Max = PB1.Max + Data1.Recordset.RecordCount
If Data1.Recordset.RecordCount > 0 Then
Data1.Recordset.MoveLast
Data1.Recordset.MoveFirst
Do While Not Data1.Recordset.EOF
Data2.Recordset.AddNew
If IsNull(Data1.Recordset.[工号]) Then
Data2.Recordset.[工号] = " "
Else
Data2.Recordset.[工号] = Data1.Recordset.[工号]
End If
If IsNull(Data1.Recordset.[部门]) Then
Data2.Recordset.[部门] = " "
Else
Data2.Recordset.[部门] = "Z" & Data1.Recordset.[部门]
End If
If IsNull(Data1.Recordset.[姓名]) Then
Data2.Recordset.[姓名] = " "
Else
Data2.Recordset.[姓名] = Data1.Recordset.[姓名]
End If
If IsNull(Data1.Recordset.[卡号]) Then
Data2.Recordset.[卡号] = " "
Else
Data2.Recordset.[卡号] = Data1.Recordset.[卡号]
End If
Data2.Recordset.[性质] = "在职"
Data2.Recordset.[实发现金] = Text1(4).Text
Data2.Recordset.Update
If PB1.Value < PB1.Max Then PB1.Value = PB1.Value + 1
Data1.Recordset.MoveNext
Loop
End If
End If
If Check1(1).Value = 1 Then
Data1.DatabaseName = xtlj & "bzxx.mdb"
SQL = "select * from [txbzk] order by 部门,工号"
Data1.RecordSource = SQL
Data1.Refresh
PB1.Max = PB1.Max + Data1.Recordset.RecordCount
If Data1.Recordset.RecordCount > 0 Then
Data1.Recordset.MoveLast
Data1.Recordset.MoveFirst
Do While Not Data1.Recordset.EOF
Data2.Recordset.AddNew
If IsNull(Data1.Recordset.[工号]) Then
Data2.Recordset.[工号] = " "
Else
Data2.Recordset.[工号] = Data1.Recordset.[工号]
End If
If IsNull(Data1.Recordset.[部门]) Then
Data2.Recordset.[部门] = " "
Else
Data2.Recordset.[部门] = "T" & Data1.Recordset.[部门]
End If
If IsNull(Data1.Recordset.[姓名]) Then
Data2.Recordset.[姓名] = " "
Else
Data2.Recordset.[姓名] = Data1.Recordset.[姓名]
End If
If IsNull(Data1.Recordset.[卡号]) Then
Data2.Recordset.[卡号] = " "
Else
Data2.Recordset.[卡号] = Data1.Recordset.[卡号]
End If
Data2.Recordset.[性质] = "退休"
Data2.Recordset.[实发现金] = Text1(4).Text
Data2.Recordset.Update
If PB1.Value < PB1.Max Then PB1.Value = PB1.Value + 1
Data1.Recordset.MoveNext
Loop
End If
End If
Frame2.Visible = False
hxfyn = MsgBox(Text1(0).Text & "年" & Text1(1).Text & "月" & Text1(2).Text & "日" & Trim(Text1(3).Text) & "临时发放库已经生成,是否立即修改该数据库?", 36)
If hxfyn = vbYes Then
Load frm临发修改
frm临发修改.datPrimaryRS.DatabaseName = lswjlj
frm临发修改.datPrimaryRS.RecordSource = "select * from [lfbzk] order by 性质,部门,工号"
frm临发修改.datPrimaryRS.Refresh
frm临发修改.Show 1
Unload Me
Else
Unload Me
End If
LSDBDK = True
Else
hxfyn = MsgBox("已经存在" & Text1(0).Text & "年" & Text1(1).Text & "月" & Text1(2).Text & "日" & Trim(Text1(3).Text) & "临发库,是否打开！", 36)
If hxfyn = vbYes Then
LSDBDK = True
hxfdbdk = False
lswjlj = xtlj & "data\" & Trim(Text1(0).Text) & Trim(Text1(1).Text) & Trim(Text1(2).Text) & ".mdb"
Else
LSDBDK = False
lswjlj = ""
End If
End If
Else
If Len(Trim(Text1(0).Text)) <> 4 Or Val(Text1(0).Text) < 1998 Or Val(Text1(0).Text) > Year(Date) Then hxfyn = MsgBox("年份必须是四位数字且必须大于等于1998且小于等于计算机当前年份！", 48)
If Len(Trim(Text1(1).Text)) <> 2 Or Val(Trim(Text1(1).Text)) < 0 Or Val(Trim(Text1(1).Text)) > 12 Then hxfyn = MsgBox("月份必须是二位数字且必须大于0且小于等于12！", 48)
If Len(Trim(Text1(2).Text)) <> 2 Or Val(Trim(Text1(2).Text)) < 0 Or Val(Trim(Text1(2).Text)) > 31 Then hxfyn = MsgBox("月份必须是二位数字且必须大于0且小于等于31！", 48)
If Len(Trim(Text1(3).Text)) = 0 Then hxfyn = MsgBox("发放名称必须填写！", 48)
If Len(Trim(Text1(4).Text)) = 0 Or Val(Text1(4).Text) <= 0 Then hxfyn = MsgBox("人均发放金额必须填写且应大于0！", 48)
End If
End If
If Index = 1 Then
Unload Me
End If
End Sub
Private Sub Form_Load()
Set wdb = wws.OpenDatabase(xtlj & "dwxx.mdb")
Set wtb1 = wdb.OpenRecordset("lfxm", dbOpenTable)
wtb1.Index = "zsy"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -