收款情况修改.frm
来自「本软件为咨询公司开发的合同管理软件,运用MDB数据库.」· FRM 代码 · 共 461 行
FRM
461 行
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form 收款情况修改
Caption = "收款情况修改"
ClientHeight = 5985
ClientLeft = 60
ClientTop = 450
ClientWidth = 8895
Icon = "收款情况修改.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5985
ScaleWidth = 8895
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Text5
Height = 375
Left = 1440
TabIndex = 18
Top = 3000
Width = 2175
End
Begin VB.CommandButton Command5
Caption = "删 除"
Height = 375
Left = 6000
TabIndex = 16
Top = 2640
Width = 975
End
Begin VB.Frame Frame1
Caption = "请输入合同编号"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 1815
Left = 5040
TabIndex = 11
Top = 480
Width = 2895
Begin VB.CommandButton Command4
Caption = "重 置"
Height = 375
Left = 1560
TabIndex = 15
Top = 1200
Width = 975
End
Begin VB.CommandButton Command3
Caption = "确 定"
Height = 375
Left = 240
TabIndex = 14
Top = 1200
Width = 975
End
Begin VB.TextBox Text2
Height = 375
Left = 1440
TabIndex = 13
Top = 480
Width = 1215
End
Begin VB.Label Label5
Caption = "合同编号："
Height = 375
Left = 360
TabIndex = 12
Top = 600
Width = 975
End
End
Begin VB.TextBox Text1
Height = 375
Left = 1440
TabIndex = 6
Top = 480
Width = 2175
End
Begin VB.TextBox Text3
Height = 375
Left = 1440
TabIndex = 5
Top = 1760
Width = 2175
End
Begin VB.TextBox Text4
Height = 375
Left = 1440
TabIndex = 4
Top = 2400
Width = 2175
End
Begin VB.CommandButton Command1
Caption = "修 改"
Height = 375
Left = 4560
TabIndex = 3
Top = 2640
Width = 975
End
Begin VB.CommandButton Command2
Caption = "返 回"
Height = 375
Left = 7440
TabIndex = 2
Top = 2640
Width = 1095
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 4200
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 4560
Visible = 0 'False
Width = 1335
End
Begin MSComCtl2.DTPicker DTP1
Height = 375
Left = 1440
TabIndex = 0
Top = 1080
Width = 2175
_ExtentX = 3836
_ExtentY = 661
_Version = 393216
Format = 23789569
CurrentDate = 39432
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 2175
Left = 0
TabIndex = 1
Top = 3720
Width = 8895
_ExtentX = 15690
_ExtentY = 3836
_Version = 393216
Cols = 6
BackColorFixed = 12648447
End
Begin VB.Label Label6
Caption = "收款情况："
Height = 375
Left = 360
TabIndex = 17
Top = 3120
Width = 975
End
Begin VB.Label Label1
Caption = "合同编号："
Height = 495
Left = 360
TabIndex = 10
Top = 480
Width = 1215
End
Begin VB.Label Label2
Caption = "收款日期："
Height = 495
Left = 360
TabIndex = 9
Top = 1125
Width = 1215
End
Begin VB.Label Label3
Caption = "收款类型："
Height = 495
Left = 360
TabIndex = 8
Top = 1755
Width = 1215
End
Begin VB.Label Label4
Caption = "收到金额："
Height = 495
Left = 360
TabIndex = 7
Top = 2400
Width = 1215
End
Begin VB.Line Line1
X1 = 4200
X2 = 4200
Y1 = 120
Y2 = 3840
End
End
Attribute VB_Name = "收款情况修改"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db1 As ADODB.Connection
Dim db2 As ADODB.Connection
Dim rs1 As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim res As Integer
Dim sqlcx As String
Dim i As Integer
Dim bh As String
Dim jn As String
Dim rq As String
Dim slqcx As String
Private Sub Command1_Click() '修改
If Trim(Text1.Text = "") Or Trim(Text3.Text = "") Or Trim(Text4.Text = "") Then
MsgBox "录入的项目不能为空,请检查!!", vbOKOnly, "提示信息!!"
Else
aa = MsgBox("你输入的数据正确吗?, 真的要保存数据吗?", vbYesNo, "保存按是, 否则按否!")
If aa = 6 Then
sqltr = " 编号 = '" & bh & "'" & " AND 收款情况 = '" & rq & "'" & " AND 收款金额 = '" & CStr(jn) & "'"
Set db1 = New ADODB.Connection
db1.CursorLocation = adUseClient
db1.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
db1.Execute ("UPDATE 收款情况 SET 编号 = '" & Trim(Text1.Text) _
& "' , 收款情况 = '" & Trim(Text3.Text) _
& "' , 收款金额 = '" & Trim(Text4.Text) _
& "' , 收款日期 = '" & CStr(Format(DTP1.Value, "yy-mm-dd")) _
& "' , 收款类型 = '" & Trim(Text5.Text) & "'" & " WHERE " & sqltr)
db1.Close
sqltr = " 编号 = '" & Trim(Text2.Text) & "'"
Set db1 = New ADODB.Connection
db1.CursorLocation = adUseClient
db1.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
Set rs1 = New ADODB.Recordset
sqltr = "select * from 收款情况 where " & sqltr
rs1.Open sqltr, db1, adOpenKeyset, adLockOptimistic
res = rs1.RecordCount
Grid1.Rows = res + 1
For i = 0 To res
If rs1.EOF = False Then
Grid1.TextMatrix(i + 1, 1) = rs1!编号
Grid1.TextMatrix(i + 1, 2) = Format(rs1!收款日期, "yy-mm-dd")
Grid1.TextMatrix(i + 1, 3) = rs1!收款情况
Grid1.TextMatrix(i + 1, 4) = rs1!收款金额
Grid1.TextMatrix(i + 1, 5) = rs1!收款类型
rs1.MoveNext
End If
Next i
Text1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
rs1.Close
rs1.ActiveConnection = Nothing
db1.Close
End If
End If
End Sub
Private Sub Command2_Click() '返回
On Error GoTo ex
rs1.Close
rs1.ActiveConnection = Nothing
Unload Me
ex:
Unload Me
End Sub
Private Sub Command3_Click() '确定
Dim sqltr As String
'dblj = "d:\htgl\data\htxxk.mdb"
sqltr = ""
If Trim(Text2.Text) <> "" Then
Set db2 = New ADODB.Connection
Set rs2 = New ADODB.Recordset
db2.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
sqlcx = "select * from 合同信息表 where 编号 = " & "'" & Trim(Text2.Text) & "'"
rs2.Open sqlcx, db2, adOpenKeyset, adLockBatchOptimistic
If rs2.EOF Then
aa = MsgBox("你输入的合同号不存在, 请重新输入", vbOKOnly)
收款情况修改.Caption = "项目单位名称："
Text3.Text = ""
Text3.SetFocus
Else
收款情况修改.Caption = ""
收款情况修改.Caption = "项目单位名称：" & 收款情况修改.Caption & rs2!单位名称 & " 签约人：" & rs2!签约人
End If
rs2.Close
rs2.ActiveConnection = Nothing
db2.Close
sqltr = " 编号 = '" & Trim(Text2.Text) & "'"
Set db1 = New ADODB.Connection
db1.CursorLocation = adUseClient
db1.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
Set rs1 = New ADODB.Recordset
sqltr = "select * from 收款情况 where " & sqltr
rs1.Open sqltr, db1, adOpenKeyset, adLockOptimistic
res = rs1.RecordCount
Grid1.Rows = res + 1
For i = 0 To res
If rs1.EOF = False Then
Grid1.TextMatrix(i + 1, 1) = rs1!编号
Grid1.TextMatrix(i + 1, 2) = Format(rs1!收款日期, "yy-mm-dd")
Grid1.TextMatrix(i + 1, 3) = rs1!收款情况
Grid1.TextMatrix(i + 1, 4) = rs1!收款金额
Grid1.TextMatrix(i + 1, 5) = rs1!收款类型
rs1.MoveNext
End If
Next i
rs1.Close
rs1.ActiveConnection = Nothing
db1.Close
If res = 0 Then
MsgBox "没有查询到你需要的数据", vbOKOnly, "信息提示!!"
Text3.SetFocus
Exit Sub
End If
Else
MsgBox "你没有输入需要查询的条件", vbOKOnly, "提示信息!"
Text3.SetFocus
End If
End Sub
Private Sub Command4_Click() '重置
Text1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text2.Text = ""
Text2.SetFocus
End Sub
Private Sub Command5_Click() '删除
If Trim(Text1.Text = "") Or Trim(Text3.Text = "") Or Trim(Text4.Text = "") Then
MsgBox "录入的项目不能为空,请检查!!", vbOKOnly, "提示信息!!"
Else
aa = MsgBox("你真的要删除数据吗?", vbYesNo, "删除按是, 否则按否!")
If aa = 6 Then
sqltr = " 编号 = '" & bh & "'" & " AND 收款情况 = '" & rq & "'" & " AND 收款金额 = '" & CStr(jn) & "'"
Set db1 = New ADODB.Connection
db1.CursorLocation = adUseClient
db1.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
db1.Execute ("DELETE from 收款情况 WHERE " & sqltr)
End If
End If
db1.Close
sqltr = " 编号 = '" & Trim(Text2.Text) & "'"
Set db1 = New ADODB.Connection
db1.CursorLocation = adUseClient
db1.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
Set rs1 = New ADODB.Recordset
sqltr = "select * from 收款情况 where " & sqltr
rs1.Open sqltr, db1, adOpenKeyset, adLockOptimistic
res = rs1.RecordCount
Grid1.Rows = res + 1
For i = 0 To res
If rs1.EOF = False Then
Grid1.TextMatrix(i + 1, 1) = rs1!编号
Grid1.TextMatrix(i + 1, 2) = Format(rs1!收款日期, "yy-mm-dd")
Grid1.TextMatrix(i + 1, 3) = rs1!收款情况
Grid1.TextMatrix(i + 1, 4) = rs1!收款金额
Grid1.TextMatrix(i + 1, 5) = rs1!收款类型
rs1.MoveNext
End If
Next i
rs1.Close
rs1.ActiveConnection = Nothing
db1.Close
Text1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
End Sub
Private Sub Form_Activate()
Text2.SetFocus
End Sub
Private Sub Form_Load()
Grid1.ColWidth(0) = 0
Grid1.ColWidth(1) = 1000
Grid1.ColWidth(2) = 2500
Grid1.ColWidth(3) = 1800
Grid1.ColWidth(4) = 1800
Grid1.ColWidth(5) = 1800
Grid1.Rows = 2
Grid1.TextMatrix(0, 1) = "合同编号"
Grid1.TextMatrix(0, 2) = " 收款日期"
Grid1.TextMatrix(0, 3) = " 收款类型"
Grid1.TextMatrix(0, 4) = " 收到金额"
Grid1.TextMatrix(0, 5) = " 收款情况"
End Sub
Private Sub Grid1_Click()
On Error GoTo cc
If Grid1.Row = 0 Then Exit Sub
Text1.Text = Trim(Grid1.TextMatrix(Grid1.Row, 1))
DTP1.Value = CDate(Grid1.TextMatrix(Grid1.Row, 2))
Text3.Text = Trim(Grid1.TextMatrix(Grid1.Row, 3))
Text4.Text = Trim(Grid1.TextMatrix(Grid1.Row, 4))
Text5.Text = Trim(Grid1.TextMatrix(Grid1.Row, 5))
bh = Trim(Grid1.TextMatrix(Grid1.Row, 1))
rq = Trim(Grid1.TextMatrix(Grid1.Row, 3))
jn = Trim(Grid1.TextMatrix(Grid1.Row, 4))
cc:
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?