📄 frmquerybill.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "Msflxgrd.ocx"
Begin VB.Form frmQueryBill
Caption = "款项查询"
ClientHeight = 4425
ClientLeft = 60
ClientTop = 345
ClientWidth = 7440
LinkTopic = "Form1"
ScaleHeight = 4425
ScaleWidth = 7440
StartUpPosition = 3 'Windows Default
Begin MSFlexGridLib.MSFlexGrid fgBill
Height = 2175
Left = 120
TabIndex = 8
Top = 2160
Width = 7215
_ExtentX = 12726
_ExtentY = 3836
_Version = 393216
End
Begin VB.CommandButton cmdCancel
Caption = "返回(&C)"
Height = 375
Left = 3840
TabIndex = 7
Top = 1560
Width = 1455
End
Begin VB.CommandButton cmdQuery
Caption = "查询(&Q)"
Height = 375
Left = 1920
TabIndex = 6
Top = 1560
Width = 1455
End
Begin VB.Frame Frame1
Caption = "选择查询方式"
Height = 1215
Left = 120
TabIndex = 0
Top = 120
Width = 7215
Begin VB.OptionButton optQueryBill
Caption = "全部款项信息"
Height = 255
Index = 2
Left = 240
TabIndex = 5
Top = 840
Width = 1455
End
Begin VB.ComboBox cboClient
Height = 315
Left = 5040
TabIndex = 4
Text = "Combo2"
Top = 360
Width = 1815
End
Begin VB.ComboBox cboContract
Height = 315
Left = 1560
TabIndex = 3
Text = "Combo1"
Top = 360
Width = 1575
End
Begin VB.OptionButton optQueryBill
Caption = "按付款单位"
Height = 255
Index = 1
Left = 3600
TabIndex = 2
Top = 360
Width = 1335
End
Begin VB.OptionButton optQueryBill
Caption = "按合同编号"
Height = 255
Index = 0
Left = 240
TabIndex = 1
Top = 360
Width = 1455
End
End
End
Attribute VB_Name = "frmQueryBill"
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 cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdQuery_Click()
queryBills
End Sub
Sub queryBills()
Dim rs As ADODB.Recordset
Dim i As Integer
Dim j As Integer
If optQueryBill(0).Value = True Then
sqlStr = "select * from fundRecords where" _
& " contractNo='" & cboContract.Text & "'"
End If
If optQueryBill(1).Value = True Then
sqlStr = "select * from fundRecords where" _
& " clientName='" & cboClient.Text & "'"
End If
If optQueryBill(2).Value = True Then
sqlStr = "select * from fundRecords"
End If
Set rs = ExecuteSQL(sqlStr, msgText)
If rs.RecordCount = 0 Then
MsgBox "没有查找满足条件的数据!", vbExclamation, "提示"
fgBill.Rows = 1
Else
fgBill.Rows = rs.RecordCount + 1
fgBill.Cols = 7
'设定行高
For i = 0 To fgBill.Rows - 1
fgBill.RowHeight(i) = 280
Next i
'设定列的属性
fgBill.Row = 0
For i = 0 To fgBill.Cols - 1
fgBill.Col = i '指定当前列为第i列
fgBill.FixedAlignment(i) = 4 '每列内容居中显示
Select Case i
Case 0
fgBill.ColWidth(i) = 600 '设定列宽
fgBill.Text = "序号"
Case 1
fgBill.ColWidth(i) = 1100 '设定列宽
fgBill.Text = "收款项目"
Case 2
fgBill.ColWidth(i) = 2000 '设定列宽
fgBill.Text = "合同编号"
Case 3
fgBill.ColWidth(i) = 700 '设定列宽
fgBill.Text = "金额"
Case 4
fgBill.ColWidth(i) = 1500 '设定列宽
fgBill.Text = "付款单位"
Case 5
fgBill.ColWidth(i) = 1000 '设定列宽
fgBill.Text = "收款日期"
Case 6
fgBill.ColWidth(i) = 1000 '设定列宽
fgBill.Text = "备注"
End Select
Next i
'rs.MoveFirst
i = 1
While (Not rs.EOF)
fgBill.Row = i
For j = 0 To fgBill.Cols - 1
fgBill.Col = j '设置当前为列为第j列
fgBill.CellAlignment = 4 '每列内容居中显示
Select Case j
Case 0
fgBill.Text = "" & i
Case 1
fgBill.Text = rs.Fields("item")
Case 2
fgBill.Text = rs.Fields("contractNo")
Case 3
fgBill.Text = rs.Fields("payment")
Case 4
fgBill.Text = rs.Fields("clientName")
Case 5
fgBill.Text = rs.Fields("opDate")
Case 6
fgBill.Text = rs.Fields("memo")
End Select
Next j
rs.MoveNext
i = i + 1
Wend
End If
rs.Close
End Sub
Sub initContractNo()
'在组合列表框中列出所有未付款合同编号
Dim rstContractNo As ADODB.Recordset
'从施工合同表中读取所有付款合同编号并添加到组合列表框中
sqlStr = "select contractNo from contract where payment>0"
Set rstContractNo = ExecuteSQL(sqlStr, msgText)
cboContract.Clear
If Not rstContractNo.EOF Then
Do While Not rstContractNo.EOF
cboContract.AddItem Trim(rstContractNo.Fields(0))
rstContractNo.MoveNext
Loop
Else
MsgBox "没有找到相关信息,请添加!", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rstContractNo.Close
End Sub
Sub initClientName()
'在组合列表框中列出所有付款单位名称
Dim rstClient As ADODB.Recordset
'从收款记录表中读取所有付款单位名称并添加到组合列表框中
sqlStr = "select DISTINCT clientName from fundRecords"
Set rstClient = ExecuteSQL(sqlStr, msgText)
cboClient.Clear
If Not rstClient.EOF Then
Do While Not rstClient.EOF
cboClient.AddItem Trim(rstClient.Fields(0))
rstClient.MoveNext
Loop
Else
MsgBox "没有找到相关信息,请添加!", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rstClient.Close
End Sub
Private Sub Form_Load()
initContractNo
initClientName
optQueryBill(0).Value = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -