📄 信息查询3.frm
字号:
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 信息查询3
Caption = "按责任人查询"
ClientHeight = 7860
ClientLeft = 60
ClientTop = 345
ClientWidth = 10305
Icon = "信息查询3.frx":0000
LinkTopic = "Form1"
ScaleHeight = 7860
ScaleWidth = 10305
StartUpPosition = 2 '屏幕中心
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access 2000;"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 285
Left = 7560
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 7560
Visible = 0 'False
Width = 1215
End
Begin VB.Frame Frame1
Caption = "请输入责任人的姓名"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 1935
Left = 240
TabIndex = 2
Top = 5640
Width = 6855
Begin MSDBCtls.DBCombo DBCombo1
Bindings = "信息查询3.frx":08CA
Height = 330
Left = 2040
TabIndex = 9
Top = 600
Width = 1575
_ExtentX = 2778
_ExtentY = 582
_Version = 393216
ListField = "责任人"
Text = ""
End
Begin VB.TextBox Text2
Height = 375
Left = 2040
TabIndex = 7
Top = 1200
Width = 1575
End
Begin VB.CommandButton Command3
Caption = "查 询"
Height = 375
Left = 4680
TabIndex = 4
Top = 480
Width = 1455
End
Begin VB.CommandButton Command4
Caption = "重 置"
Height = 375
Left = 4680
TabIndex = 3
Top = 1200
Width = 1455
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 = 495
Left = 960
TabIndex = 8
Top = 1245
Width = 975
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
Height = 375
Left = 960
TabIndex = 5
Top = 600
Width = 1095
End
End
Begin VB.CommandButton Command1
Caption = "输出到EXCEL"
Height = 495
Left = 8040
TabIndex = 1
Top = 6000
Width = 1575
End
Begin VB.CommandButton Command2
Caption = "返 回"
Height = 495
Left = 8040
TabIndex = 0
Top = 6960
Width = 1575
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 5295
Left = 0
TabIndex = 6
Top = 0
Width = 10335
_ExtentX = 18230
_ExtentY = 9340
_Version = 393216
Cols = 12
BackColorFixed = 12648447
End
End
Attribute VB_Name = "信息查询3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim dyk As ADODB.Connection
Dim dyr As ADODB.Recordset
Dim dysql 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 As Integer
Dim htje, lzf, zxf As Double
Private Sub DBCombo1_Change()
Data1.RecordSource = "select * from 责任人 where 责任人 like '*" & Trim(DBCombo1.Text) & "*'"
Data1.Refresh
End Sub
Private Sub DBCombo1_Click(Area As Integer)
DBCombo1.Refresh
DBCombo1.ListField = "责任人"
DBCombo1.ReFill
End Sub
Private Sub Command1_Click()
If jls = 0 Then
MsgBox "没有需要的数据!!", vbOKOnly, "提示信息!!"
Else
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(DBCombo1.Text) & " 合同情况表"
For i = 0 To jls - 1
xlsheet.Cells(i + 4, 1) = Trim(Grid1.TextMatrix(i + 1, 2))
xlsheet.Cells(i + 4, 2) = Trim(Grid1.TextMatrix(i + 1, 3))
xlsheet.Cells(i + 4, 3) = Trim(Grid1.TextMatrix(i + 1, 4))
xlsheet.Cells(i + 4, 4) = Trim(Grid1.TextMatrix(i + 1, 5))
xlsheet.Cells(i + 4, 5) = Trim(Grid1.TextMatrix(i + 1, 6))
xlsheet.Cells(i + 4, 6) = Trim(Grid1.TextMatrix(i + 1, 7))
xlsheet.Cells(i + 4, 7) = Trim(Grid1.TextMatrix(i + 1, 8))
xlsheet.Cells(i + 4, 8) = Trim(Grid1.TextMatrix(i + 1, 9))
xlsheet.Cells(i + 4, 9) = Trim(Grid1.TextMatrix(i + 1, 10))
xlsheet.Cells(i + 4, 10) = Trim(Grid1.TextMatrix(i + 1, 11))
Next i
xlsheet.Cells(i + 4, 3) = Grid1.TextMatrix(jls + 1, 4)
xlsheet.Cells(i + 4, 4) = Trim(Grid1.TextMatrix(jls + 1, 5))
xlsheet.Cells(i + 4, 5) = Trim(Grid1.TextMatrix(jls + 1, 6))
xlsheet.Cells(i + 4, 6) = Trim(Grid1.TextMatrix(jls + 1, 7))
xlsheet.Cells(i + 6, 7) = "打印日期：" & Date
With xlsheet
.Range(.Cells(3, 1), .Cells(i + 4, 10)).Borders.LineStyle = xlContinuous '设置边框
End With
xlApp.Caption = "表打印预览"
xlApp.Visible = True
xlApp.ActiveSheet.PrintPreview '打印预览
xlbook.Save '保存文件
xlbook.Close
xlApp.quit '退出EXCEL
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
If DBCombo1.Text = "" Then
MsgBox "请输入责任人姓名!!", vbOKOnly, "提示信息!!"
Else
dysql = "select * from 合同信息表 where left(编号,2) = '" & Trim(Text2.Text) & "' AND 部门责任人 like '" & Trim(DBCombo1.Text) & "%'"
Set dyk = New ADODB.Connection
dyk.CursorLocation = adUseClient
dyk.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
Set dyr = New ADODB.Recordset
dyr.Open dysql, dyk, adOpenKeyset, adLockOptimistic
jls = dyr.RecordCount
If jls = 0 Then
MsgBox "你需要的数据没有查到!!", vbOKOnly, "提示信息!!"
Else
htje = 0
lzf = 0
zxf = 0
Grid1.Rows = jls + 2
For i = 0 To jls
If dyr.EOF = False Then
Grid1.TextMatrix(i + 1, 1) = i + 1
Grid1.TextMatrix(i + 1, 2) = dyr!编号
Grid1.TextMatrix(i + 1, 3) = dyr!签约人
Grid1.TextMatrix(i + 1, 4) = dyr!单位名称
Grid1.TextMatrix(i + 1, 5) = dyr!合同金额
Grid1.TextMatrix(i + 1, 6) = dyr!认证费
Grid1.TextMatrix(i + 1, 7) = dyr!咨询费
Grid1.TextMatrix(i + 1, 8) = dyr!咨询师
Grid1.TextMatrix(i + 1, 9) = dyr!部门责任人
Grid1.TextMatrix(i + 1, 10) = dyr!体系
Grid1.TextMatrix(i + 1, 11) = dyr!认证机构
htje = htje + Val(dyr!合同金额)
lzf = lzf + Val(dyr!认证费)
zxf = zxf + Val(dyr!咨询费)
dyr.MoveNext
End If
Next i
Grid1.TextMatrix(jls + 1, 1) = ""
Grid1.TextMatrix(jls + 1, 2) = ""
Grid1.TextMatrix(jls + 1, 3) = ""
Grid1.TextMatrix(jls + 1, 4) = " 合 计"
Grid1.TextMatrix(jls + 1, 5) = htje
Grid1.TextMatrix(jls + 1, 6) = lzf
Grid1.TextMatrix(jls + 1, 7) = zxf
Grid1.TextMatrix(jls + 1, 8) = ""
Grid1.TextMatrix(jls + 1, 9) = ""
Grid1.TextMatrix(jls + 1, 10) = ""
Grid1.TextMatrix(jls + 1, 11) = ""
dyr.Close
dyk.Close
End If
End If
End Sub
Private Sub Command4_Click()
DBCombo1.Text = ""
Text2.Text = ""
DBCombo1.SetFocus
End Sub
Private Sub Form_Activate()
DBCombo1.SetFocus
End Sub
Private Sub Form_Load()
'dblj = "d:\htgl\data\htxxk.mdb"
Data1.DatabaseName = dblj
Data1.RecordSource = "责任人"
Grid1.ColWidth(0) = 0
Grid1.ColWidth(1) = 700
Grid1.ColWidth(2) = 700
Grid1.ColWidth(3) = 1000
Grid1.ColWidth(4) = 3000
Grid1.ColWidth(5) = 1000
Grid1.ColWidth(6) = 1000
Grid1.ColWidth(7) = 1000
Grid1.ColWidth(8) = 1000
Grid1.ColWidth(9) = 1000
Grid1.ColWidth(10) = 1000
Grid1.ColWidth(11) = 1000
Grid1.Rows = 25
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) = " 咨询师"
Grid1.TextMatrix(0, 9) = " 责任人"
Grid1.TextMatrix(0, 10) = " 认证体系"
Grid1.TextMatrix(0, 11) = " 认证机构"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -