收款情况查询.frm
来自「本软件为咨询公司开发的合同管理软件,运用MDB数据库.」· FRM 代码 · 共 478 行
FRM
478 行
VERSION 5.00
Object = "{FAEEE763-117E-101B-8933-08002B2F4F5A}#1.1#0"; "DBLIST32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form 收款情况查询
Caption = "收款情况查询"
ClientHeight = 6495
ClientLeft = 60
ClientTop = 450
ClientWidth = 8625
Icon = "收款情况查询.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6495
ScaleWidth = 8625
StartUpPosition = 2 '屏幕中心
Begin VB.Data Data2
Caption = "Data2"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 5040
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 3720
Visible = 0 'False
Width = 1140
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 6480
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 3600
Visible = 0 'False
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "返 回"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6120
TabIndex = 6
Top = 2400
Width = 1575
End
Begin VB.CommandButton Command1
Caption = "输出到EXCEL"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6120
TabIndex = 5
Top = 1080
Width = 1575
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 = 2895
Left = 720
TabIndex = 0
Top = 360
Width = 4455
Begin MSDBCtls.DBCombo DBC1
Bindings = "收款情况查询.frx":08CA
Height = 330
Left = 1560
TabIndex = 10
Top = 1200
Width = 2415
_ExtentX = 4260
_ExtentY = 582
_Version = 393216
ListField = "单位名称"
Text = ""
End
Begin VB.TextBox Text2
Height = 375
Left = 1560
TabIndex = 3
Top = 480
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "确 定"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 2
Top = 2160
Width = 975
End
Begin VB.CommandButton Command4
Caption = "重 置"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2640
TabIndex = 1
Top = 2160
Width = 975
End
Begin VB.Label Label2
Caption = "单位名称："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 9
Top = 1200
Width = 1335
End
Begin VB.Label Label5
Caption = "合同编号："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 4
Top = 600
Width = 1335
End
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 2175
Left = 0
TabIndex = 7
Top = 4320
Width = 8655
_ExtentX = 15266
_ExtentY = 3836
_Version = 393216
Cols = 6
BackColorFixed = 12648447
End
Begin VB.Label Label1
Caption = "合同总金额："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 480
TabIndex = 8
Top = 3600
Width = 3135
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, bt As String
Dim bh As String
Dim jn As String
Dim rq As String
Dim slqcx, strsql As String
Dim xlApp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim strSource, strDestination As String
Dim jls, i, j, f, k, n As Integer
'Dim dblj As String
Dim dylj As String
Dim htdb, jgdb As ADODB.Connection
Dim htrs, jgrs As ADODB.Recordset
Private Sub Command1_Click() '打印
' On Error GoTo er
aa = MsgBox("你要打印数据吗?", vbYesNo, "打印按是, 否则按否!")
If aa = 6 Then
Set htdb = New ADODB.Connection
htdb.CursorLocation = adUseClient
htdb.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
Set htrs = New ADODB.Recordset
sqltr = "select * from 收款情况 where " & "编号=" & "'" & Trim(Text2.Text) & "'"
htrs.Open sqltr, htdb, adOpenKeyset, adLockOptimistic
res = htrs.RecordCount
If res <> 0 Then
Set xlApp = New Excel.Application '建立excel应用程序
Set xlApp = CreateObject("Excel.Application") '激活EXCEL应用程序
'Set xlbook = xlApp.Workbooks.Add
'设定工作表
strSource = App.Path + "\rpt\收款情况表.xls" 'jcchzb.xls是一个模版文件
strDestination = App.Path + "\temp\收款情况表.xls"
FileCopy strSource, strDestination '将模版文件拷贝到一个临时文件
Set xlbook = xlApp.Workbooks.Open(strDestination) '打开工作簿，strDestination为一个EXCEL报表文件
Set xlsheet = xlbook.Worksheets(1) '打开工作表1
xlsheet.Cells(1, 1) = "第 " & Trim(Text2.Text) & "号合同收款情况表"
xlsheet.Cells(2, 1) = bt
For i = 0 To res - 1
xlsheet.Cells(i + 4, 1) = i + 1
xlsheet.Cells(i + 4, 2) = Trim(htrs!收款日期)
xlsheet.Cells(i + 4, 3) = Trim(htrs!收款情况)
xlsheet.Cells(i + 4, 4) = Trim(htrs!收款金额)
xlsheet.Cells(i + 4, 5) = Trim(htrs!收款类型)
If htrs.EOF = False Then
htrs.MoveNext
End If
Next i
xlsheet.Cells(i + 5, 4) = "打印日期：" & Date
With xlsheet
.Range(.Cells(3, 1), .Cells(i + 3, 5)).Borders.LineStyle = xlContinuous '设置边框
End With
xlApp.Caption = "表打印预览"
xlApp.Visible = True
xlApp.ActiveSheet.PrintPreview '打印预览
xlbook.Save '保存文件
xlbook.Close
xlApp.quit '退出EXCEL
htrs.ActiveConnection = Nothing
htdb.Close
Exit Sub
Else
aa = MsgBox("没有需要打印数据!", vbOKOnly, "信息提示!")
End If
Exit Sub
End If
Exit Sub
er:
htrs.ActiveConnection = Nothing
htdb.Close
xlbook.Close
xlApp.quit '退出EXCEL
Unload Me
End Sub
Private Sub Command2_Click() '返回
On Error GoTo ex
rs1.Close
rs1.ActiveConnection = Nothing
Unload Me
ex:
Unload Me
End Sub
Private Sub Command4_Click() '重置
Text2.Text = ""
DBC1.Text = ""
Label1.Caption = "合同总金额："
Text2.SetFocus
End Sub
Private Sub DBC1_Change()
Data2.RecordSource = "select * from 合同信息表 where 单位名称 like '*" & Trim(DBC1.Text) & "*'"
Data2.Refresh
End Sub
Private Sub DBC1_Click(Area As Integer)
DBC1.Refresh
DBC1.ListField = "单位名称"
DBC1.ReFill
End Sub
Private Sub DBC1_LostFocus()
On Error GoTo aa
Set jgdb = New ADODB.Connection
jgdb.CursorLocation = adUseClient
jgdb.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
strsql = "select * from 合同信息表 where 单位名称 = " & "'" & Trim(DBC1.Text) & "'" '搜索满足条件的记录
Set jgrs = New ADODB.Recordset
jgrs.Open strsql, jgdb, adOpenKeyset, adLockOptimistic
Text2.Text = jgrs!编号
jgrs.Close
jgrs.ActiveConnection = Nothing
jgdb.Close
aa:
End Sub
Private Sub Command3_Click() '确定
On Error GoTo cc
Dim sqltr As String
'Dim ljs As Double
ljs = 0
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
Label1.Caption = "合同总金额：" & rs2!合同金额 & " 元"
If rs2.EOF Then
aa = MsgBox("你输入的合同号不存在, 请重新输入", vbOKOnly)
收款情况查询.Caption = "项目单位名称："
Text2.Text = ""
Text2.SetFocus
Else
收款情况查询.Caption = ""
收款情况查询.Caption = "项目单位名称：" & 收款情况查询.Caption & rs2!单位名称 & " 签约人：" & rs2!签约人
End If
bt = "项目单位名称：" & rs2!单位名称 & " 签约人：" & rs2!签约人
DBC1.Text = rs2!单位名称
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!收款类型
'ljs = ljs + Val(Trim(rs1!收款金额))
rs1.MoveNext
End If
Next i
rs1.Close
rs1.ActiveConnection = Nothing
db1.Close
If res = 0 Then
MsgBox "没有查询到你需要的数据", vbOKOnly, "信息提示!!"
Text2.SetFocus
Exit Sub
End If
Else
MsgBox "你没有输入需要查询的条件", vbOKOnly, "提示信息!"
Text2.SetFocus
End If
cc:
End Sub
Private Sub Form_Activate()
Text2.SetFocus
End Sub
Private Sub Form_Load()
'dblj = "c:\htgl\data\htxxk.mdb"
Data2.DatabaseName = dblj
Data2.RecordSource = "合同信息表"
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
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?