发信人: chenyoung(灌水) 
整理人: gzwsh(2002-11-05 22:59:39), 站内信件
 | 
 
 
以前的一个例子
 
 Public Sub ExcelPrint(rsPrint As ADODB.Recordset)
     If rsPrint.EOF Then
         MsgBox "没有数据!", vbCritical
         Exit Sub
     End If
     
     Dim appExcel As Excel.Application
     Dim docExcel As Excel.Workbook
     Dim shtExcel As Excel.Worksheet
     Dim strFileName As String
     Dim fs As Object
     
     On Error Resume Next '忽略错误
     
     Set appExcel = GetObject(, "Excel.Application") '查找一个正在运行的 Excel 副本。
     If Err.Number <> 0 Then '如果 Word 没有被运行
         Set appExcel = CreateObject("Excel.Application") '运行它
     End If
     Err.Clear   ' 在错误发生的情况下清除 Err 对象。
     
     On Error GoTo 0 '继续标准的出错进程
     Set fs = CreateObject("Scripting.FileSystemObject")
     strFileName = fs.GetSpecialFolder(2) & "\" & fs.GetTempName
     If fs.FileExists(strFileName) Then
     End If
     
     Set docExcel = appExcel.Workbooks.Open(App.Path & "\1.xls")
     Set shtExcel = docExcel.Worksheets("sheet1")
     shtExcel.Cells(7, 2) = "" & rsPrint.Fields("项目名称")
     shtExcel.Cells(7, 5) = "" & rsPrint.Fields("建设地点")
     shtExcel.Cells(8, 2) = "" & rsPrint.Fields("建设单位")
     shtExcel.Cells(8, 5) = "" & rsPrint.Fields("项目负责人")
     shtExcel.Cells(9, 2) = "" & rsPrint.Fields("总投资")
     shtExcel.Cells(9, 5) = "" & rsPrint.Fields("建筑面积")
     shtExcel.Cells(10, 2) = "" & rsPrint.Fields("开工时间")
     shtExcel.Cells(10, 5) = "" & rsPrint.Fields("竣工时间")
     shtExcel.Cells(11, 2) = "" & rsPrint.Fields("项目简介")
     
     shtExcel.Cells(12, 3) = "" & rsPrint.Fields("年份1")
     shtExcel.Cells(13, 3) = "" & rsPrint.Fields("计划投资1")
     shtExcel.Cells(14, 3) = "" & rsPrint.Fields("计划文号1")
     shtExcel.Cells(12, 4) = "" & rsPrint.Fields("年份2")
     shtExcel.Cells(13, 4) = "" & rsPrint.Fields("计划投资2")
     shtExcel.Cells(14, 4) = "" & rsPrint.Fields("计划文号2")
     shtExcel.Cells(12, 5) = "" & rsPrint.Fields("年份3")
     shtExcel.Cells(13, 5) = "" & rsPrint.Fields("计划投资3")
     shtExcel.Cells(14, 5) = "" & rsPrint.Fields("计划文号3")
     shtExcel.Cells(12, 6) = "" & rsPrint.Fields("年份4")
     shtExcel.Cells(13, 6) = "" & rsPrint.Fields("计划投资4")
     shtExcel.Cells(14, 6) = "" & rsPrint.Fields("计划文号4")
     
     shtExcel.Cells(16, 2) = "" & rsPrint.Fields("拨款日期1")
     shtExcel.Cells(16, 3) = "" & rsPrint.Fields("拨款金额1")
     shtExcel.Cells(16, 4) = "" & rsPrint.Fields("实际拨款1")
     shtExcel.Cells(16, 5) = "" & rsPrint.Fields("累计拨款1")
     shtExcel.Cells(16, 6) = "" & rsPrint.Fields("经手人1")
     shtExcel.Cells(17, 2) = "" & rsPrint.Fields("拨款日期2")
     shtExcel.Cells(17, 3) = "" & rsPrint.Fields("拨款金额2")
     shtExcel.Cells(17, 4) = "" & rsPrint.Fields("实际拨款2")
     shtExcel.Cells(17, 5) = "" & rsPrint.Fields("累计拨款2")
     shtExcel.Cells(17, 6) = "" & rsPrint.Fields("经手人2")
     shtExcel.Cells(18, 2) = "" & rsPrint.Fields("拨款日期3")
     shtExcel.Cells(18, 3) = "" & rsPrint.Fields("拨款金额3")
     shtExcel.Cells(18, 4) = "" & rsPrint.Fields("实际拨款3")
     shtExcel.Cells(18, 5) = "" & rsPrint.Fields("累计拨款3")
     shtExcel.Cells(18, 6) = "" & rsPrint.Fields("经手人3")
     shtExcel.Cells(19, 2) = "" & rsPrint.Fields("拨款日期4")
     shtExcel.Cells(19, 3) = "" & rsPrint.Fields("拨款金额4")
     shtExcel.Cells(19, 4) = "" & rsPrint.Fields("实际拨款4")
     shtExcel.Cells(19, 5) = "" & rsPrint.Fields("累计拨款4")
     shtExcel.Cells(19, 6) = "" & rsPrint.Fields("经手人4")
     
     shtExcel.Cells(20, 2) = "" & rsPrint.Fields("审计结果")
     shtExcel.Cells(21, 2) = "" & rsPrint.Fields("结算情况")
     
     docExcel.SaveAs (strFileName)
     appExcel.Visible = True
     docExcel.PrintPreview
 
 End Sub
 
 【 在 hunter__fox 的大作中提到:】
 :主要是想在控件里打开Excel表格,并实现打印功能。
 :目前,我使用的是一个OCX控件。打印时完全通过代码写表单,再使用 PrintFrom 方法来完成。
 :
 :......
  
 
  ---- <img src="http://uh1.gz.163.com photo?name=mailtocy"> | 
 
 
 |