📄 frmbillcontract.frm
字号:
VERSION 5.00
Begin VB.Form frmBillContract
Caption = "合同收款"
ClientHeight = 3825
ClientLeft = 60
ClientTop = 345
ClientWidth = 6855
LinkTopic = "Form1"
ScaleHeight = 3825
ScaleWidth = 6855
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdCancel
Caption = "返回(&C)"
Height = 375
Left = 3720
TabIndex = 13
Top = 3240
Width = 1335
End
Begin VB.CommandButton cmdSave
Caption = "保存(&S)"
Height = 375
Left = 1680
TabIndex = 12
Top = 3240
Width = 1335
End
Begin VB.Frame Frame1
Caption = "收款信息"
Height = 2895
Left = 120
TabIndex = 0
Top = 120
Width = 6615
Begin VB.TextBox txtUnpaid
Enabled = 0 'False
ForeColor = &H000000FF&
Height = 285
Left = 4680
TabIndex = 16
Top = 840
Width = 1215
End
Begin VB.TextBox txtBill
Height = 285
Index = 1
Left = 1320
TabIndex = 14
Top = 840
Width = 1335
End
Begin VB.TextBox txtBill
Height = 855
Index = 3
Left = 1320
TabIndex = 11
Top = 1800
Width = 5055
End
Begin VB.ComboBox cboClient
Height = 315
Left = 1320
TabIndex = 10
Top = 1320
Width = 2055
End
Begin VB.TextBox txtBill
Height = 285
Index = 2
Left = 4680
TabIndex = 9
Top = 1320
Width = 1695
End
Begin VB.ComboBox cboContractNo
Height = 315
Left = 4680
TabIndex = 8
Top = 360
Width = 1695
End
Begin VB.TextBox txtBill
Height = 285
Index = 0
Left = 1320
TabIndex = 7
Top = 360
Width = 1935
End
Begin VB.Label Label8
Caption = "（元）"
Height = 255
Index = 1
Left = 5880
TabIndex = 18
Top = 840
Width = 615
End
Begin VB.Label Label8
Caption = "（元）"
Height = 255
Index = 0
Left = 2760
TabIndex = 17
Top = 840
Width = 615
End
Begin VB.Label Label7
Caption = "未付金额："
Height = 255
Left = 3600
TabIndex = 15
Top = 840
Width = 975
End
Begin VB.Label Label6
Caption = "备注信息："
Height = 255
Left = 360
TabIndex = 6
Top = 1800
Width = 975
End
Begin VB.Label Label5
Caption = "付款单位："
Height = 255
Left = 360
TabIndex = 5
Top = 1320
Width = 975
End
Begin VB.Label Label4
Caption = "收款日期："
Height = 255
Left = 3600
TabIndex = 4
Top = 1320
Width = 975
End
Begin VB.Label Label3
Caption = "付款金额："
Height = 255
Left = 360
TabIndex = 3
Top = 840
Width = 975
End
Begin VB.Label Label2
Caption = "合同编号："
Height = 255
Left = 3600
TabIndex = 2
Top = 360
Width = 975
End
Begin VB.Label Label1
Caption = "收款项目："
Height = 255
Left = 360
TabIndex = 1
Top = 360
Width = 1095
End
End
End
Attribute VB_Name = "frmBillContract"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public sqlStr As String
Public msgText As String
Private Sub cboContractNo_Click()
'查找并显示合同的未付款金额
txtUnpaid.Text = getPayment(cboContractNo.Text)
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
Dim rstBillInfo As ADODB.Recordset
Dim i As Integer
For i = 0 To 2
If txtBill(i).Text = "" Then
MsgBox "请将信息填写完整", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
Next i
'向收款记录表中添加新记录
sqlStr = "select * from fundRecords"
Set rstBillInfo = ExecuteSQL(sqlStr, msgText)
rstBillInfo.AddNew
'设置各个字段的值
rstBillInfo.Fields("item") = txtBill(0).Text
rstBillInfo.Fields("contractNo") = cboContractNo.Text
rstBillInfo.Fields("payment") = txtBill(1).Text
rstBillInfo.Fields("opDate") = txtBill(2).Text
rstBillInfo.Fields("clientName") = cboClient.Text
rstBillInfo.Fields("memo") = txtBill(3).Text
rstBillInfo.Update
rstBillInfo.Close
'修改合同中的付款信息
updatePayment cboContractNo.Text
MsgBox "付款信息添加完成！", vbOKOnly + vbExclamation, "警告"
End Sub
Private Sub Form_Load()
initClient
initContractNo
txtBill(2).Text = Format(Date, "yyyy-mm-dd")
End Sub
Sub initClient()
'在组合列表框中列出所有客户名称
Dim rstClientName As ADODB.Recordset
'从客户表中读取所有客户名称并添加到组合列表框中
sqlStr = "select clientName from client"
Set rstClientName = ExecuteSQL(sqlStr, msgText)
cboClient.Clear
If Not rstClientName.EOF Then
Do While Not rstClientName.EOF
cboClient.AddItem Trim(rstClientName.Fields(0))
rstClientName.MoveNext
Loop
Else
MsgBox "没有找到相关信息，请添加！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rstClientName.Close
End Sub
Sub initContractNo()
'在组合列表框中列出所有未付款合同编号
Dim rstContractNo As ADODB.Recordset
'从施工合同表中读取所有未付款合同编号并添加到组合列表框中
sqlStr = "select contractNo from contract where payment<amount"
Set rstContractNo = ExecuteSQL(sqlStr, msgText)
cboContractNo.Clear
If Not rstContractNo.EOF Then
Do While Not rstContractNo.EOF
cboContractNo.AddItem Trim(rstContractNo.Fields(0))
rstContractNo.MoveNext
Loop
Else
MsgBox "没有找到相关信息，请添加！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rstContractNo.Close
End Sub
Function getPayment(contractNo As String) As Double
Dim rstContract As ADODB.Recordset
Dim mySqlStr As String
'按合同编号从施工合同表中查询该合同的未付款信息
mySqlStr = "select (amount-payment) as unpaid from contract" _
& " where contractNo='" & contractNo & "'"
Set rstContract = ExecuteSQL(mySqlStr, msgText)
If Not rstContract.EOF Then
getPayment = Val(rstContract.Fields("unpaid"))
Else
MsgBox "没有找到相关数据！！"
End If
End Function
Sub updatePayment(contractNo As String)
Dim conn As ADODB.Connection
'组合得到完成数据修改的SQL语句
sqlStr = "update contract set payment=payment+" _
& Trim(txtBill(1).Text) _
& " where contractNo='" & contractNo & "'"
On Error GoTo exitSub
Set conn = New ADODB.Connection
conn.Open connStr
'执行SQL语句
conn.Execute sqlStr
MsgBox "合同信息修改完成!!"
exitSub:
conn.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -