Crystal reports 9 的使用示例

'*crystal report 的使用示例
'*適用版本：9.0
'*製作人：馬亞紅
'*製作時間：2004年12月28日
'*情況：此為在水晶報表軟體中製作報表（rpt檔案）的呼叫方式
'*選單->工程->引用->選擇：
'*1、Crystal Reports 9 ActiveX Desioner Desion and Runtime Library
'*2、Crystal Reports 9 activeX Desioner Run Time Library
'*好多朋友有這個問題：報表顯示後資料沒有重新整理,解決方法如下：
'*1、在報表的設計介面，選單“檔案”--》“選項”--》“建立報表”選項卡--》把“將資料與報表一起儲存”前的勾去掉後儲存即可
'*2、呼叫報表物件的DiscardSavedData方法
'*****************************************************************
Option Explicit
Dim Report As New CrystalReport1
Dim wjfilesys As FileSystemObject 'FSO 物件，用於檔案操作
Dim WithEvents CrSecRH As Section '報表顯示區物件
Dim capp As New CRAXDDRT.Application '報表集合物件
Dim carp As New CRAXDRT.Report '報表集合中的報表物件
Dim carsubp As New CRAXDRT.Report '報表集合物件中的子報表物件
Dim Pic2 As OLEObject '報表物件中的Ole物件

Dim mytxt As CRAXDRT.TextObject '報表物件中的Textbox物件

Private Sub Combo1_Change() '放大（縮小）比例
CRViewer91.Zoom (CInt(Combo1.Text))
End Sub
Private Sub Command1_Click() '顯示第一頁
CRViewer91.ShowFirstPage
End Sub
Private Sub Command10_Click() '列印報表
CRViewer91.PrintReport
End Sub
Private Sub Command11_Click()
CRViewer91.showclosebutton
End Sub
Private Sub Command2_Click() '重新整理報表
CRViewer91.Refresh
End Sub
Private Sub Command3_Click() '顯示上一頁
CRViewer91.ShowPreviousPage
End Sub
Private Sub Command4_Click() '顯示下一頁
CRViewer91.ShowNextPage
End Sub
Private Sub Command5_Click() '顯示最後一頁
CRViewer91.ShowLastPage
End Sub
Private Sub Command6_Click() '在報表內容內搜尋
If (txtSearch.Text <> "") Then
CRViewer91.SearchForText (txtSearch.Text)
End If
txtSearch.Text = ""
End Sub
Private Sub Command7_Click() '匯入出PDF

Dim myExportFile As String
myExportFile = App.Path + "temp.pdf"
If wjfilesys.FileExists(myExportFile) Then
wjfilesys.DeleteFile (myExportFile)
End If
Report.ExportOptions.DiskFileName = myExportFile

Report.ExportOptions.FormatType = crEFTPortableDocFormat
Report.ExportOptions.DestinationType = crEDTDiskFile
Report.ExportOptions.PDFExportAllPages = True
Report.Export (False)
End Sub
Private Sub Command8_Click() '匯出到Excel
Dim myExportFile As String
myExportFile = App.Path + "temp.xls"
If wjfilesys.FileExists(myExportFile) Then
wjfilesys.DeleteFile (myExportFile)
End If
Report.ExportOptions.DiskFileName = myExportFile
Report.ExportOptions.FormatType = crEFTExcel97
Report.ExportOptions.DestinationType = crEDTDiskFile
Report.ExportOptions.PDFExportAllPages = True
Report.Export (False)
End Sub
Private Sub Command9_Click() '匯出到WORD
Dim myExportFile As String
myExportFile = App.Path + "temp.doc"
If wjfilesys.FileExists(myExportFile) Then
wjfilesys.DeleteFile (myExportFile)
End If
Report.ExportOptions.DiskFileName = myExportFile

Report.ExportOptions.FormatType = crEFTWordForWindows
Report.ExportOptions.DestinationType = crEDTDiskFile
Report.ExportOptions.PDFExportAllPages = True
Report.Export (False)
End Sub
Private Sub Form_Load()
Screen.MousePointer = vbHourglass
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strsql As String
Dim i As Integer
If cn.State = adStateOpen Then cn.Close
'SQL SERVER連線方式
With cn
.Provider = "sqloledb"
.ConnectionString = "data source=dd;initial catalog=dfd;user id=sa;password=aaa"
.Open
End With
'Mdb的連線方式
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" + App.Path + "Test.mdb;Persist Security Info=False"
.Open
End With
strsql = "select * from carsort"
If rs.State = adStateOpen Then rs.Close
With rs
.ActiveConnection = cn
.CursorLocation = adUseClient
.Open strsql, cn, adOpenDynamic, adLockOptimistic
End With
Set carp = capp.OpenReport(App.Path + "CryStalTest.rpt") '取報表物件
Set carsubp = carp.OpenSubreport("myhgyp") '取子報表物件

Set CrSecRH = carp.Sections("PageHeaderSection1") '取報表頭顯示區物件
Set Pic2 = carp.Sections("PageHeaderSection1").ReportObjects("picture1") '取報表頭顯示區中的Ole物件
Set mytxt = CrSecRH.ReportObjects("mytxt")
For i = 1 To carp.Database.Tables.Count '設定報表的資料來源
If carp.Database.Tables.Item(i).Name = "carsort" Then
carp.Database.Tables(i).SetDataSource rs
End If
Next
For i = 1 To carsubp.Database.Tables.Count '設定子報表的資料來源
If carp.Database.Tables.Item(i).Name = "carsort" Then
carsubp.Database.Tables(i).SetDataSource rs
End If
Next
Screen.MousePointer = vbHourglass
'第一種設定引數的方式
carp.ParameterFields(1).ClearCurrentValueAndRange
carp.ParameterFields(1).AddCurrentValue ("myhgyp")
carp.ParameterFields(2).ClearCurrentValueAndRange
carp.ParameterFields(2).AddCurrentValue (CInt("3"))
'第二種設定引數的方式
carp.ParameterFields.GetItemByName("gg").ClearCurrentValueAndRange
carp.ParameterFields.GetItemByName("gg").AddCurrentValue ("myh11" & vbCrLf & "-2gyp")
carp.ParameterFields.GetItemByName("ff").ClearCurrentValueAndRange
carp.ParameterFields.GetItemByName("ff").AddCurrentValue (CInt("673"))
carp.DiscardSavedData
CRViewer91.ReportSource = carp
CRViewer91.ViewReport
Screen.MousePointer = vbDefault
CRViewer91.Zoom 100
'----------------------
Screen.MousePointer = vbDefault
Set wjfilesys = CreateObject("Scripting.FileSystemObject")
End Sub
Private Sub CrSecRH_Format(ByVal pFormattingInfo As Object) '格式化報表頭顯示區中的物件
Set Pic2.FormattedPicture = LoadPicture(App.Path & "tsconfig.bmp") 'changes the pic in the Report Header
mytxt.SetText Format(mytxt.Text, "####年##月##日") '格式化TextBox中的文字顯示方式
End Sub
Private Sub Form_Resize() '設定報表顯示區域
CRViewer91.Top = 0
CRViewer91.Left = 0
CRViewer91.Height = ScaleHeight
CRViewer91.Width = ScaleWidth
End Sub

[@more@]