开票情况查询.frm
来自「本软件为咨询公司开发的合同管理软件,运用MDB数据库.」· FRM 代码 · 共 416 行
FRM
416 行
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 = 5415
ClientLeft = 60
ClientTop = 450
ClientWidth = 10935
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Icon = "开票情况查询.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5415
ScaleWidth = 10935
StartUpPosition = 2 '屏幕中心
Begin VB.Data Data2
Caption = "Data2"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 7200
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 3000
Visible = 0 'False
Width = 1215
End
Begin VB.Frame Frame1
Caption = "请输入合同编号及单位名称"
ForeColor = &H000000FF&
Height = 2655
Left = 600
TabIndex = 3
Top = 240
Width = 6255
Begin MSDBCtls.DBCombo DBC1
Bindings = "开票情况查询.frx":08CA
Height = 390
Left = 2400
TabIndex = 10
Top = 1270
Width = 3015
_ExtentX = 5318
_ExtentY = 688
_Version = 393216
ListField = "单位名称"
Text = ""
End
Begin VB.CommandButton Command4
Caption = "重 置"
Height = 495
Left = 3240
TabIndex = 7
Top = 1920
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "确 定"
Height = 495
Left = 1200
TabIndex = 6
Top = 1920
Width = 1095
End
Begin VB.TextBox Text1
Height = 495
Left = 2400
TabIndex = 5
Top = 480
Width = 1935
End
Begin VB.Label Label3
Caption = "单位名称："
Height = 375
Left = 1080
TabIndex = 9
Top = 1320
Width = 1215
End
Begin VB.Label Label1
Caption = "合同编号："
Height = 495
Left = 1080
TabIndex = 4
Top = 600
Width = 1455
End
End
Begin VB.CommandButton Command1
Caption = "输出到EXCEL"
Height = 375
Left = 7920
TabIndex = 2
Top = 720
Width = 1455
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 1935
Left = 120
TabIndex = 1
Top = 3480
Width = 10815
_ExtentX = 19076
_ExtentY = 3413
_Version = 393216
Cols = 9
BackColorFixed = 12648447
End
Begin VB.CommandButton Command2
Caption = "返 回"
Height = 375
Left = 7920
TabIndex = 0
Top = 1680
Width = 1455
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 4200
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 3720
Visible = 0 'False
Width = 1215
End
Begin VB.Label Label2
Caption = "合同总金额："
ForeColor = &H000000FF&
Height = 375
Left = 600
TabIndex = 8
Top = 3100
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 As ADODB.Connection
Dim htrs As ADODB.Recordset
Dim jgdb As ADODB.Connection
Dim 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(Text1.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(Text1.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!开票金额)
xlsheet.Cells(i + 4, 6) = Trim(htrs!票号)
xlsheet.Cells(i + 4, 7) = Trim(htrs!开票人)
xlsheet.Cells(i + 4, 8) = Trim(htrs!备注)
If htrs.EOF = False Then
htrs.MoveNext
End If
Next i
xlsheet.Cells(i + 5, 7) = "打印日期：" & Date
With xlsheet
.Range(.Cells(3, 1), .Cells(i + 3, 8)).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 Command3_Click() '确定
Dim sqltr As String
sqltr = ""
If Trim(Text1.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(Text1.Text) & "'"
rs2.Open sqlcx, db2, adOpenKeyset, adLockBatchOptimistic
If rs2.EOF Then
aa = MsgBox("你输入的合同号不存在, 请重新输入", vbOKOnly)
开票情况查询.Caption = "项目单位名称："
Text1.Text = ""
Text1.SetFocus
Else
开票情况查询.Caption = ""
开票情况查询.Caption = "项目单位名称：" & 开票情况查询.Caption & rs2!单位名称 & " 签约人：" & rs2!签约人
End If
bt = "项目单位名称：" & rs2!单位名称 & " 签约人：" & rs2!签约人
Label2.Caption = "合同总金额：" & rs2!合同金额 & "元"
DBC1.Text = rs2!单位名称
rs2.Close
rs2.ActiveConnection = Nothing
db2.Close
sqltr = " 编号 = '" & Trim(Text1.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) = rs1!部门
Grid1.TextMatrix(i + 1, 3) = Format(rs1!开票日期, "yy-mm-dd")
Grid1.TextMatrix(i + 1, 4) = rs1!开票种类
Grid1.TextMatrix(i + 1, 5) = rs1!开票金额
Grid1.TextMatrix(i + 1, 6) = rs1!票号
Grid1.TextMatrix(i + 1, 7) = rs1!开票人
Grid1.TextMatrix(i + 1, 8) = rs1!备注
rs1.MoveNext
End If
Next i
rs1.Close
rs1.ActiveConnection = Nothing
db1.Close
If res = 0 Then
MsgBox "没有查询到你需要的数据", vbOKOnly, "信息提示!!"
Text1.SetFocus
Exit Sub
End If
Else
MsgBox "你没有输入需要查询的条件", vbOKOnly, "提示信息!"
Text1.SetFocus
End If
End Sub
Private Sub Command4_Click() '重置
Text1.Text = ""
DBC1.Text = ""
Label2.Caption = "合同总金额："
Text1.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
Text1.Text = jgrs!编号
jgrs.Close
jgrs.ActiveConnection = Nothing
jgdb.Close
aa:
End Sub
Private Sub Form_Activate()
Text1.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) = 800
Grid1.ColWidth(2) = 1900
Grid1.ColWidth(3) = 1200
Grid1.ColWidth(4) = 1200
Grid1.ColWidth(5) = 1300
Grid1.ColWidth(6) = 1200
Grid1.ColWidth(7) = 1200
Grid1.ColWidth(8) = 1850
Grid1.Rows = 2
Grid1.TextMatrix(0, 1) = "编 号"
Grid1.TextMatrix(0, 2) = " 部 门"
Grid1.TextMatrix(0, 3) = " 开票日期"
Grid1.TextMatrix(0, 4) = " 开票种类"
Grid1.TextMatrix(0, 5) = " 开票金额"
Grid1.TextMatrix(0, 6) = " 票 号"
Grid1.TextMatrix(0, 7) = " 开票人"
Grid1.TextMatrix(0, 8) = " 开票情况"
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?