rt

解决方案 »

  1.   

    VB中的报表控件也可以,如下:Option ExplicitDim adoConnectionX As New ADODB.Connection
    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
      

  2.   

    '------------------------------------------------------------------------
      '以下可根据实际情况通过控制集合的元素来准确有效的控制这些元素所代表的控件。
      '例如:
      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
      

  3.   

    谢谢cuizm(射天狼) ,让我学了不少东西,顶~~~~
      

  4.   

    看看这个:1、支持最终用户设计、修改报表,只需连接相关的数据源,指出数据的位
    置(设置报表样式),无论是主从表,子报表,套表,都可迅速生成。开发
    一个报表只需几分钟的时间。
     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