📄 信息打印.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form 信息打印
Caption = "按年份查询合同信息"
ClientHeight = 7875
ClientLeft = 60
ClientTop = 345
ClientWidth = 10350
Icon = "信息打印.frx":0000
LinkTopic = "Form1"
ScaleHeight = 7875
ScaleWidth = 10350
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "返 回"
Height = 495
Left = 8040
TabIndex = 4
Top = 6960
Width = 1575
End
Begin VB.CommandButton Command1
Caption = "输出到EXCEL"
Height = 495
Left = 8040
TabIndex = 3
Top = 6000
Width = 1575
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 = 0
Top = 5640
Width = 6855
Begin VB.CommandButton Command4
Caption = "重 置"
Height = 375
Left = 4680
TabIndex = 7
Top = 1200
Width = 1455
End
Begin VB.CommandButton Command3
Caption = "查 询"
Height = 375
Left = 4680
TabIndex = 6
Top = 480
Width = 1455
End
Begin VB.TextBox Text1
Height = 375
Left = 2040
TabIndex = 2
Top = 840
Width = 1575
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 = 1200
TabIndex = 1
Top = 840
Width = 855
End
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 5295
Left = 0
TabIndex = 5
Top = 0
Width = 10335
_ExtentX = 18230
_ExtentY = 9340
_Version = 393216
Cols = 17
BackColorFixed = 12648447
End
End
Attribute VB_Name = "信息打印"
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 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) = "上海万韵咨询技术有限公司 20" & Trim(Text1.Text) & " 年合同情况表"
For i = 0 To jls - 1
xlsheet.Cells(i + 4, 1) = Trim(Grid1.TextMatrix(i + 1, 1))
xlsheet.Cells(i + 4, 2) = Trim(Grid1.TextMatrix(i + 1, 2))
xlsheet.Cells(i + 4, 3) = Trim(Grid1.TextMatrix(i + 1, 3))
xlsheet.Cells(i + 4, 4) = Trim(Grid1.TextMatrix(i + 1, 4))
xlsheet.Cells(i + 4, 5) = Trim(Grid1.TextMatrix(i + 1, 5))
xlsheet.Cells(i + 4, 6) = Trim(Grid1.TextMatrix(i + 1, 6))
xlsheet.Cells(i + 4, 7) = Trim(Grid1.TextMatrix(i + 1, 7))
xlsheet.Cells(i + 4, 8) = Trim(Grid1.TextMatrix(i + 1, 8))
xlsheet.Cells(i + 4, 9) = Trim(Grid1.TextMatrix(i + 1, 9))
xlsheet.Cells(i + 4, 10) = Trim(Grid1.TextMatrix(i + 1, 10))
xlsheet.Cells(i + 4, 11) = Trim(Grid1.TextMatrix(i + 1, 11))
xlsheet.Cells(i + 4, 12) = Trim(Grid1.TextMatrix(i + 1, 12))
xlsheet.Cells(i + 4, 13) = Trim(Grid1.TextMatrix(i + 1, 13))
xlsheet.Cells(i + 4, 14) = Trim(Grid1.TextMatrix(i + 1, 14))
xlsheet.Cells(i + 4, 15) = Trim(Grid1.TextMatrix(i + 1, 15))
xlsheet.Cells(i + 4, 16) = Trim(Grid1.TextMatrix(i + 1, 16))
Next i
xlsheet.Cells(i + 4, 3) = Grid1.TextMatrix(jls + 1, 3)
xlsheet.Cells(i + 4, 13) = Trim(Grid1.TextMatrix(jls + 1, 13))
xlsheet.Cells(i + 4, 14) = Trim(Grid1.TextMatrix(jls + 1, 14))
xlsheet.Cells(i + 4, 15) = Trim(Grid1.TextMatrix(jls + 1, 15))
xlsheet.Cells(i + 6, 14) = "打印日期：" & Date
With xlsheet
.Range(.Cells(3, 1), .Cells(i + 4, 16)).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 Len(Trim(Text1.Text)) <> 2 Then
MsgBox "你输入数据有误，请输入年份的后两位数!!", vbOKOnly, "提示信息!!"
Else
If Text1.Text = "" Then
MsgBox "请输入需要查询的年份!!", vbOKOnly, "提示信息!!"
Else
dysql = "select * from 合同信息表 where 编号 like '" & Trim(Text1.Text) & "%' ORDER BY 编号 ASC"
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
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!认证机构
Grid1.TextMatrix(i + 1, 12) = dyr!认证性质
Grid1.TextMatrix(i + 1, 13) = dyr!合同金额
Grid1.TextMatrix(i + 1, 14) = dyr!认证费
Grid1.TextMatrix(i + 1, 15) = dyr!咨询费
Grid1.TextMatrix(i + 1, 16) = dyr!备注
htje = htje + Val(dyr!合同金额)
lzf = lzf + Val(dyr!认证费)
zxf = zxf + Val(dyr!咨询费)
dyr.MoveNext
End If
Next i
Grid1.TextMatrix(jls + 1, 3) = " 合 计"
Grid1.TextMatrix(jls + 1, 13) = htje
Grid1.TextMatrix(jls + 1, 14) = lzf
Grid1.TextMatrix(jls + 1, 15) = zxf
dyr.Close
dyk.Close
End If
End If
End Sub
Private Sub Command4_Click()
Text1.Text = ""
Text1.SetFocus
End Sub
Private Sub Form_Activate()
Text1.SetFocus
End Sub
Private Sub Form_Load()
'dblj = App.Path + "\data\htxxk.mdb"
Grid1.ColWidth(0) = 0
Grid1.ColWidth(1) = 500
Grid1.ColWidth(2) = 700
Grid1.ColWidth(3) = 2500
Grid1.ColWidth(4) = 950
Grid1.ColWidth(5) = 800
Grid1.ColWidth(6) = 800
Grid1.ColWidth(7) = 800
Grid1.ColWidth(8) = 1000
Grid1.ColWidth(9) = 1000
Grid1.ColWidth(10) = 1000
Grid1.ColWidth(11) = 1000
Grid1.ColWidth(12) = 1000
Grid1.ColWidth(13) = 1000
Grid1.ColWidth(14) = 1000
Grid1.ColWidth(15) = 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) = "认证机构"
Grid1.TextMatrix(0, 12) = "企业类别"
Grid1.TextMatrix(0, 13) = " 合同金额"
Grid1.TextMatrix(0, 14) = " 认证费"
Grid1.TextMatrix(0, 15) = " 咨询费"
Grid1.TextMatrix(0, 16) = " 备 注 "
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -