这是我昨天写的一个简单的处理水晶报表的类.
可以参考一下.
Option Explicit
Private str_FileName As String
Private m_Report As CRAXDRT.Report
Private m_Application As CRAXDDRT.Application
Private objReportViewer As CRViewer9
Public Function ExportFiles(byte_Type As Byte) As Boolean
If Dir(str_FileName) <> "" Then
Kill str_FileName
End If
On Error GoTo errHandle
With m_Report
.ExportOptions.DiskFileName = str_FileName
.ExportOptions.DestinationType = crEDTDiskFile
If byte_Type = 1 Then '导出PDF
.ExportOptions.FormatType = crEFTPortableDocFormat
.ExportOptions.PDFExportAllPages = True
ElseIf byte_Type = 2 Then '导出Excel
.ExportOptions.FormatType = crEFTExcel97
.ExportOptions.ExcelExportAllPages = True
ElseIf byte_Type = 3 Then '导出Word
.ExportOptions.FormatType = crEFTWordForWindows
.ExportOptions.WORDWExportAllPages = True
End If
.Export (False)
End With
ExportFiles = True
Exit Function
errHandle:
ExportFiles = False
End Function
Public Property Let SetReport(ReportFile As String)
Set m_Report = m_Application.OpenReport(ReportFile)
End Property
Public Property Let SetDatabaseSource(Con As ADODB.Connection)
m_Report.Database.SetDataSource Con
End Property
Public Sub SetTableReportSource(tbName As String, Rs As ADODB.Recordset)
Dim i As Integer
For i = 1 To m_Report.Database.Tables.Count
If m_Report.Database.Tables.Item(i).Name = tbName Then
m_Report.Database.Tables(i).SetDataSource Rs
End If
Next
End Sub
Public Sub ShowReport()
objReportViewer.ReportSource = m_Report
objReportViewer.ViewReport
objReportViewer.Zoom 100
End Sub
'设定文件名
Public Property Let FileName(s_Filename As String)
str_FileName = s_Filename
End Property
'设置报表控件
Public Property Let ReportViewer(rViewer As CRViewer9)
Set objReportViewer = rViewer
End Property
'打印报表
Public Sub PrintReport()
objReportViewer.PrintReport
End Sub
Public Sub ShowNextPage()
objReportViewer.ShowNextPage
End Sub
Public Sub ShowFirstPage()
objReportViewer.ShowFirstPage
End Sub
Public Sub ShowPreviousPage()
objReportViewer.ShowPreviousPage
End Sub
Public Sub ShowLastPage()
objReportViewer.ShowLastPage
End Sub
Private Sub Class_Initialize()
Set m_Application = New CRAXDDRT.Application
End Sub
Private Sub Class_Terminate()
On Error Resume Next
Set m_Report = Nothing
Set m_Application = Nothing
End Sub