VB中的报表控件也可以,如下:Option ExplicitDim adoConnectionX As New ADODB.Connection Dim adoRecordsetX As New ADODB.RecordsetPrivate Sub DataReport_Initialize() 'printer.Orientation = '以下准备数据源(记录集) '要打印的数据源(记录集)必须是一个全局级别的,或者是本设计器模块级别的记录集
Dim PHSec2_RptLbl_Collection As New Collection '页标头(PageHeader)区域 Label(RptLabel) 控件集合 Dim DSec1_RptLbl_Collection As New Collection '细节(Detail)区域 Label(RptLabel) 控件集合 Dim PFSec3_RptLbl_Collection As New Collection '页注脚(PageFooter)区域 Label(RptLabel) 控件
Dim PHSec2_RptShp_Collection As New Collection '页标头(PageHeader)区域 Shape(RptShape) 控件集合 Dim DSec1_RptShp_Collection As New Collection '细节(Detail)区域 Shape(RptShape) 控件集合 Dim PFSec3_RptShp_Collection As New Collection '页注脚(PageFooter)区域 Shape(RptShape) 控件集合
Dim DSec1_RptTxt_Collection As New Collection '细节(Detail)区域 TextBox(RptTextBox) 控件集合 'TextBox (RptTextBox) 控件只能绘制到细节(Detail)区域
Dim PHSec2_RptImg_Collection As New Collection '页标头(PageHeader)区域 Image(RptImage) 控件集合 Dim DSec1_RptImg_Collection As New Collection '细节(Detail)区域 Image(RptImage) 控件集合 Dim PFSec3_RptImg_Collection As New Collection '页注脚(PageFooter)区域 Image(RptImage) 控件集合
Dim PHSec2_RptLine_Collection As New Collection '页标头(PageHead)区域 Line(RptLine) 控件集合 Dim DSec1_RptLine_Collection As New Collection '细节(Detail)区域 Line(RptLine) 控件集合 Dim PFSec3_RptLine_Collection As New Collection '页注脚(PageFooter)区域 Line(RptLine) 控件集合
Dim Ctl 'As Object
For Each Ctl In DataReport1.Sections.Item("Section2").Controls 'Section2 Select Case TypeName(Ctl) Case "RptLabel" PHSec2_RptLbl_Collection.Add Ctl Ctl.Caption = "" Case "RptShape" PHSec2_RptShp_Collection.Add Ctl Case "RptLine" PHSec2_RptLine_Collection.Add Ctl Case "RptImage" PHSec2_RptImg_Collection.Add Ctl End Select Ctl.Left = 0 Ctl.Top = 0 Ctl.Height = 300 Ctl.Width = (Rnd + 1) * 600 Ctl.Visible = False Next Ctl
For Each Ctl In DataReport1.Sections.Item("Section1").Controls 'Section1 Select Case TypeName(Ctl) Case "RptLabel" DSec1_RptLbl_Collection.Add Ctl Ctl.Caption = "" Case "RptShape" DSec1_RptShp_Collection.Add Ctl Case "RptTextBox" Ctl.DataField = adoRecordsetX.Fields.Item(0).Name '先将所有TextBox(RptTextBox) 控件绑定到某一字段 '否则报错! DSec1_RptTxt_Collection.Add Ctl Case "RptLine" DSec1_RptLine_Collection.Add Ctl Case "RptImage" DSec1_RptImg_Collection.Add Ctl End Select Ctl.Left = 0 Ctl.Top = 0 Ctl.Height = 400 Ctl.Width = 600 Ctl.Visible = False Next Ctl
For Each Ctl In DataReport1.Sections.Item("Section3").Controls 'Section3 Select Case TypeName(Ctl) Case "RptLabel" PFSec3_RptLbl_Collection.Add Ctl Ctl.Caption = "" Case "RptShape" PFSec3_RptShp_Collection.Add Ctl Case "RptLine" PFSec3_RptLine_Collection.Add Ctl Case "RptImage" PFSec3_RptImg_Collection.Add Ctl End Select Ctl.Left = 0 Ctl.Top = 0 Ctl.Height = 400 Ctl.Width = (Rnd + 1) * 600 Ctl.Visible = False Next Ctl
'------------------------------------------------------------------------ '以下可根据实际情况通过控制集合的元素来准确有效的控制这些元素所代表的控件。 '例如: Dim i As Integer
Dim bFmt As StdDataFormat '定义布尔(Boolean)型字段的数据格式 Set bFmt = New StdDataFormat bFmt.Type = fmtBoolean bFmt.TrueValue = "是" bFmt.FalseValue = "否"
For i = 0 To 6 '只打印前七个字段 'Shape(RptShape) 控件用来显示单元格
'页标头(PageHeader)区域:显示列表头(Caption) With PHSec2_RptShp_Collection.Item(i + 1) '单元格 .Visible = True If i = 0 Then .Left = 0 Else .Left = PHSec2_RptShp_Collection.Item(i).Left + PHSec2_RptShp_Collection.Item(i).Width End If .Top = 0 .Height = 400 '可根据字体设 单位:缇 '字体的高度(单位:缇)可使用 Form、PictureBox 的 'TextHeight 方法或 API 获得 .Width = 1500 '这里可根据实际情况分别设置各列的列宽 .BorderColor = vbRed .BorderStyle = rptBSSolid .Shape = rptShpRectangle End With With PHSec2_RptLbl_Collection.Item(i + 1) '列表头标题(Caption) .Visible = True .Left = PHSec2_RptShp_Collection.Item(i + 1).Left + 100 .Top = PHSec2_RptShp_Collection.Item(i + 1).Top + 100 .Height = PHSec2_RptShp_Collection.Item(i + 1).Height - 180 .Width = PHSec2_RptShp_Collection.Item(i + 1).Width - 200 .Caption = adoRecordsetX.Fields.Item(i).Name
'VB6 提供的控制方法不利于编程分别控制各类控件: Debug.Print Me.Sections.Item("Section2").Controls.Item("Label1").Caption End SubPrivate Sub DataReport_QueryClose(Cancel As Integer, CloseMode As Integer) adoConnectionX.Close Set adoConnectionX = Nothing Set adoRecordsetX = Nothing End Sub
Dim adoRecordsetX As New ADODB.RecordsetPrivate Sub DataReport_Initialize()
'printer.Orientation =
'以下准备数据源(记录集)
'要打印的数据源(记录集)必须是一个全局级别的,或者是本设计器模块级别的记录集
'数据库使用的是 Northwind.mdb
adoConnectionX.Open "dsn=sybase;uid=sa;pwd=abcd1234" '"Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & App.Path & "\Northwind.mdb"
adoRecordsetX.Open "select * from STUDENTCARD", adoConnectionX
Set DataReport1.DataSource = adoRecordsetX '设置 DataReport 的数据源
'-------------------------------------------------------------------------
'以下根据控件所在区域(Sections)和所属控件类别等将它们分成若干集合
Dim PHSec2_RptLbl_Collection As New Collection '页标头(PageHeader)区域 Label(RptLabel) 控件集合
Dim DSec1_RptLbl_Collection As New Collection '细节(Detail)区域 Label(RptLabel) 控件集合
Dim PFSec3_RptLbl_Collection As New Collection '页注脚(PageFooter)区域 Label(RptLabel) 控件
Dim PHSec2_RptShp_Collection As New Collection '页标头(PageHeader)区域 Shape(RptShape) 控件集合
Dim DSec1_RptShp_Collection As New Collection '细节(Detail)区域 Shape(RptShape) 控件集合
Dim PFSec3_RptShp_Collection As New Collection '页注脚(PageFooter)区域 Shape(RptShape) 控件集合
Dim DSec1_RptTxt_Collection As New Collection '细节(Detail)区域 TextBox(RptTextBox) 控件集合
'TextBox (RptTextBox) 控件只能绘制到细节(Detail)区域
Dim PHSec2_RptImg_Collection As New Collection '页标头(PageHeader)区域 Image(RptImage) 控件集合
Dim DSec1_RptImg_Collection As New Collection '细节(Detail)区域 Image(RptImage) 控件集合
Dim PFSec3_RptImg_Collection As New Collection '页注脚(PageFooter)区域 Image(RptImage) 控件集合
Dim PHSec2_RptLine_Collection As New Collection '页标头(PageHead)区域 Line(RptLine) 控件集合
Dim DSec1_RptLine_Collection As New Collection '细节(Detail)区域 Line(RptLine) 控件集合
Dim PFSec3_RptLine_Collection As New Collection '页注脚(PageFooter)区域 Line(RptLine) 控件集合
Dim Ctl 'As Object
For Each Ctl In DataReport1.Sections.Item("Section2").Controls 'Section2
Select Case TypeName(Ctl)
Case "RptLabel"
PHSec2_RptLbl_Collection.Add Ctl
Ctl.Caption = ""
Case "RptShape"
PHSec2_RptShp_Collection.Add Ctl
Case "RptLine"
PHSec2_RptLine_Collection.Add Ctl
Case "RptImage"
PHSec2_RptImg_Collection.Add Ctl
End Select
Ctl.Left = 0
Ctl.Top = 0
Ctl.Height = 300
Ctl.Width = (Rnd + 1) * 600
Ctl.Visible = False
Next Ctl
For Each Ctl In DataReport1.Sections.Item("Section1").Controls 'Section1
Select Case TypeName(Ctl)
Case "RptLabel"
DSec1_RptLbl_Collection.Add Ctl
Ctl.Caption = ""
Case "RptShape"
DSec1_RptShp_Collection.Add Ctl
Case "RptTextBox"
Ctl.DataField = adoRecordsetX.Fields.Item(0).Name '先将所有TextBox(RptTextBox) 控件绑定到某一字段
'否则报错!
DSec1_RptTxt_Collection.Add Ctl
Case "RptLine"
DSec1_RptLine_Collection.Add Ctl
Case "RptImage"
DSec1_RptImg_Collection.Add Ctl
End Select
Ctl.Left = 0
Ctl.Top = 0
Ctl.Height = 400
Ctl.Width = 600
Ctl.Visible = False
Next Ctl
For Each Ctl In DataReport1.Sections.Item("Section3").Controls 'Section3
Select Case TypeName(Ctl)
Case "RptLabel"
PFSec3_RptLbl_Collection.Add Ctl
Ctl.Caption = ""
Case "RptShape"
PFSec3_RptShp_Collection.Add Ctl
Case "RptLine"
PFSec3_RptLine_Collection.Add Ctl
Case "RptImage"
PFSec3_RptImg_Collection.Add Ctl
End Select
Ctl.Left = 0
Ctl.Top = 0
Ctl.Height = 400
Ctl.Width = (Rnd + 1) * 600
Ctl.Visible = False
Next Ctl
'以下可根据实际情况通过控制集合的元素来准确有效的控制这些元素所代表的控件。
'例如:
Dim i As Integer
Dim bFmt As StdDataFormat '定义布尔(Boolean)型字段的数据格式
Set bFmt = New StdDataFormat
bFmt.Type = fmtBoolean
bFmt.TrueValue = "是"
bFmt.FalseValue = "否"
For i = 0 To 6 '只打印前七个字段
'Shape(RptShape) 控件用来显示单元格
'页标头(PageHeader)区域:显示列表头(Caption)
With PHSec2_RptShp_Collection.Item(i + 1) '单元格
.Visible = True
If i = 0 Then
.Left = 0
Else
.Left = PHSec2_RptShp_Collection.Item(i).Left + PHSec2_RptShp_Collection.Item(i).Width
End If
.Top = 0
.Height = 400 '可根据字体设 单位:缇
'字体的高度(单位:缇)可使用 Form、PictureBox 的
'TextHeight 方法或 API 获得
.Width = 1500 '这里可根据实际情况分别设置各列的列宽
.BorderColor = vbRed
.BorderStyle = rptBSSolid
.Shape = rptShpRectangle
End With
With PHSec2_RptLbl_Collection.Item(i + 1) '列表头标题(Caption)
.Visible = True
.Left = PHSec2_RptShp_Collection.Item(i + 1).Left + 100
.Top = PHSec2_RptShp_Collection.Item(i + 1).Top + 100
.Height = PHSec2_RptShp_Collection.Item(i + 1).Height - 180
.Width = PHSec2_RptShp_Collection.Item(i + 1).Width - 200
.Caption = adoRecordsetX.Fields.Item(i).Name
.BorderStyle = rptBSSolid '调试用
.BorderColor = vbGreen '调试用
.BackStyle = rptBkOpaque '调试用
.BackColor = vbYellow '调试用
.Alignment = rptJustifyCenter
.Font.Name = ""
.Font.Size = 10
.Font.Bold = False
.Font.Italic = False
.Font.Strikethrough = False
.Font.Underline = False
.ForeColor = vbBlue
End With
'细节(Detail)区域显示:
With DSec1_RptShp_Collection.Item(i + 1) '单元格
.Visible = True
If i = 0 Then
DSec1_RptShp_Collection.Item(i + 1).Left = 0
Else
.Left = DSec1_RptShp_Collection.Item(i).Left + DSec1_RptShp_Collection.Item(i).Width
End If
.Top = 0
.Height = PHSec2_RptShp_Collection.Item(i + 1).Height
.Width = PHSec2_RptShp_Collection.Item(i + 1).Width
.BorderColor = PHSec2_RptShp_Collection.Item(i + 1).BorderColor
.BorderStyle = PHSec2_RptShp_Collection.Item(i + 1).BorderStyle
.Shape = PHSec2_RptShp_Collection.Item(i + 1).Shape
End With
With DSec1_RptTxt_Collection.Item(i + 1) '数据
.Visible = True
.Height = DSec1_RptShp_Collection.Item(i + 1).Height - 180
.Left = DSec1_RptShp_Collection.Item(i + 1).Left + 100
.Top = DSec1_RptShp_Collection.Item(i + 1).Top + 100
.Width = DSec1_RptShp_Collection.Item(i + 1).Width - 200
.Font.Name = PHSec2_RptLbl_Collection.Item(i + 1).Font.Name
.Font.Size = PHSec2_RptLbl_Collection.Item(i + 1).Font.Size
.Font.Bold = PHSec2_RptLbl_Collection.Item(i + 1).Font.Bold
.Font.Italic = PHSec2_RptLbl_Collection.Item(i + 1).Font.Italic
.Font.Strikethrough = PHSec2_RptLbl_Collection.Item(i + 1).Font.Strikethrough
.Font.Underline = PHSec2_RptLbl_Collection.Item(i + 1).Font.Underline
.ForeColor = PHSec2_RptLbl_Collection.Item(i + 1).ForeColor
.DataField = adoRecordsetX.Fields.Item(i).Name '重新绑定字段
Select Case adoRecordsetX.Fields.Item(i).Type '可根据字段数据类型设置数据格式
Case adBigInt, adInteger, adSmallInt
.DataFormat.Format = "###,##0" '数字
.Alignment = rptJustifyRight
Case adBoolean
Set .DataFormat = bFmt '布尔型字段设为自定义格式
.Alignment = rptJustifyCenter
Case adCurrency
.DataFormat.Format = "###,##0.00" '货币
.Alignment = rptJustifyRight
Case adDate, adDBDate, adDBTimeStamp
.DataFormat.Format = "Long Date" '日期、时间
.Alignment = rptJustifyRight
Case Else '其它,如:文本等
.Alignment = rptJustifyLeft
End Select
' .BorderStyle = rptBSSolid '调试用
' .BorderColor = vbGreen '调试用
' .BackStyle = rptBkOpaque '调试用
' .BackColor = vbYellow '调试用
End With
Next i
DataReport1.Sections.Item("Section2").Height = 400
DataReport1.Sections.Item("Section1").Height = 400
'VB6 提供的控制方法不利于编程分别控制各类控件:
Debug.Print Me.Sections.Item("Section2").Controls.Item("Label1").Caption
End SubPrivate Sub DataReport_QueryClose(Cancel As Integer, CloseMode As Integer)
adoConnectionX.Close Set adoConnectionX = Nothing
Set adoRecordsetX = Nothing
End Sub
置(设置报表样式),无论是主从表,子报表,套表,都可迅速生成。开发
一个报表只需几分钟的时间。
2、报表样式可以保存为rmf格式,下次可通过读入使用(配合SQL脚本就可以生成
报表)。并可以把带数据的报表保存为rmp格式,在任何机器上都可以浏览、打印,
而不需要数据库。
3、生成后的报表支持修改,包括字体的设置,边框的设置,修改内容等。
4、完全、自由自定义页面、边距、字体,标题和页眉页脚,并可以在自认合适的
地方插入函数来实现当前日期,页合计,总合计等功能,合计字段可以放在页头,分
组头,并支持条件合计,对分组合计,分页合计,总计等只需简单地设置属性即可。
5、报表中可以在自认合适的事件(on beforeprint,on afterprint等)中加入程
序脚本,以控制、或实现更复杂的打印效果。
6、更新迅速,可根据使用人员与用户的意见,不断的加入新的功能。
7、多种格式转换,可以把做出的报表转换为html,xls,pdf,bmp,jpeg等等格式。
8、自动对超长记录折行,超长的内容也会自动折行,中文换行不会乱码。
9、首家支持缩放打印功能,可以根据打印时选择的纸张自动缩放报表。
10、首家支持即打即停.
11、首家提供类似excel的报表设计器,给你足够灵活方表的报表设计方式。
12、首家提供双报表设计器(第一种,第二种),满足所有的需求。
13、更是提供类似于ObjectPascal的script,实现特殊功能。
14、首家提供报表压缩处理,占用内存更少,生成报表速度更快。
15、首家提供合并单元格功能,更加适应处理复杂的中文报表。
16、自动填空行,每页打印数量等细节处理更完善。下载地址:
http://www.reportmachine.net/gb/html/download/open.asp?id=795&url=/download/com/rmcom_Demo.rarhttp://www.reportmachine.net
http://www.delphireport.com.cn