报表高手请进！

Option ExplicitDim adoConnectionX As New ADODB.Connection
Dim adoRecordsetX As New ADODB.RecordsetPrivate Sub DataReport_Initialize()
  'printer.Orientation =
  '以下准备数据源(记录集)
  '要打印的数据源(记录集)必须是一个全局级别的，或者是本设计器模块级别的记录集

  '数据库使用的是 Northwind.mdb
  adoConnectionX.Open "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & App.Path & "\Northwind.mdb"
  adoRecordsetX.Open "select * from 产品", 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

这是源码!!不过要先在报表中先多放几个LABEL与TEXT!!

射天狼大哥：非常感谢你给的代码，由于我对报表不熟，所以还有些问题请教你。
你代码上的Section1, Section2，Section3…
具体是代表哪个区域（报表头，页标头，细节，页注脚，报表脚）？
还有，是否需要在报表设计器上的每个Section区域内预先放置一些控件（RptLable, RptTextBox, RptShape,RptLine），然后让代码动为其分配呢?

to: 射天狼Dim Ctl 'As Object这一句是什么意思？Ctl 是个什么东西，怎么可以放入for 循环中。
另外运行你贴的代码时，报错说With PHSec2_RptShp_Collection.Item(i + 1)
使用“无效的过程调用或参数”。
我也正在做报表，以前没做过，想运行一下找点感觉！希望赐教！

调试易

报表高手请进！

解决方案 »