📄 部门开票查询.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form 部门开票查询
Caption = "部门开票查询"
ClientHeight = 8220
ClientLeft = 60
ClientTop = 345
ClientWidth = 10515
Icon = "部门开票查询.frx":0000
LinkTopic = "Form1"
ScaleHeight = 8220
ScaleWidth = 10515
StartUpPosition = 2 '屏幕中心
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 4080
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 3840
Visible = 0 'False
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "返 回"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8040
TabIndex = 8
Top = 1920
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "输出到EXCEL"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8040
TabIndex = 6
Top = 960
Width = 1455
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 = 2655
Left = 480
TabIndex = 0
Top = 360
Width = 6255
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 2400
TabIndex = 10
Top = 1320
Width = 2175
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2400
TabIndex = 3
Top = 480
Width = 1935
End
Begin VB.CommandButton Command3
Caption = "确 定"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1200
TabIndex = 2
Top = 1920
Width = 1095
End
Begin VB.CommandButton Command4
Caption = "重 置"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3240
TabIndex = 1
Top = 1920
Width = 1095
End
Begin VB.Label Label1
Caption = "年 份："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1080
TabIndex = 5
Top = 600
Width = 1455
End
Begin VB.Label Label3
Caption = "部门名称："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1080
TabIndex = 4
Top = 1320
Width = 1215
End
End
Begin VB.Data Data2
Caption = "Data2"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 7080
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 3120
Visible = 0 'False
Width = 1215
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 4575
Left = 0
TabIndex = 7
Top = 3600
Width = 10455
_ExtentX = 18441
_ExtentY = 8070
_Version = 393216
Cols = 9
BackColorFixed = 12648447
End
Begin VB.Label Label2
Caption = "合同总金额："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 480
TabIndex = 9
Top = 3225
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 left(编号,2) = '" & Trim(Text1.Text) & "' AND 部门 like '" & Trim(Combo1.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) = "20" & Trim(Text1.Text) & "年" & Trim(Combo1.Text) & "合同开票情况表"
xlsheet.Cells(2, 1) = bt
xlsheet.Cells(3, 1) = "合同号"
For i = 0 To res - 1
xlsheet.Cells(i + 4, 1) = Trim(htrs!编号)
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 left(编号,2) = '" & Trim(Text1.Text) & "' AND 部门 like '" & Trim(Combo1.Text) & "%'"
rs2.Open sqlcx, db2, adOpenKeyset, adLockBatchOptimistic
If rs2.EOF Then
aa = MsgBox("你输入的合同号不存在, 请重新输入", vbOKOnly)
Text1.Text = ""
Text1.SetFocus
Else
End If
rs2.Close
rs2.ActiveConnection = Nothing
db2.Close
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 left(编号,2) = '" & Trim(Text1.Text) & "' AND 部门 like '" & Trim(Combo1.Text) & "%'"
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 = ""
Combo1.Text = ""
'Label2.Caption = "合同总金额："
Text1.SetFocus
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 = "开票情况表"
Combo1.AddItem "本部"
Combo1.AddItem "丁部"
Combo1.AddItem "郭部"
Combo1.AddItem "王部"
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 + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -