打印动态报表
我现在的做法是：
设计一张空的报表，设计好表头、字段栏、数据栏、页头、页尾的容器，不增加任何控件
然后动态的创建每一个field(有多少个数据栏就有多少个field)
现在的问题是：
如果数据多了，field的top肯定很大，产生溢出
我知道这种想法是不对的，但我要动态的创建field，因为field的数目不固定，想不出好办法了，下面是源码：
Private Sub ActiveReport_DataInitialize()
Dim strCaption As String
Dim StrTitle As String
Dim Arp1Title As Object
Dim Arp1FdName As Object
Dim Arp1FdValue As Object
Dim Arp1Line As Object
Dim TitleWidth As Integer
Dim PageType As Integer
Dim PrintDirection As Integer
Dim PageLeft As Integer
Dim PageRight As Integer
Dim PageTop As Integer
Dim PageBottom As Integer
Dim FieldWidth As Integer
Dim FieldHeight As Integer
Dim DetailHeight As Integer
Dim CurCol As Integer
Dim CurRow As Integer'获得定义值
strCaption = "报表预览"
StrTitle = strReporttitle
TitleWidth = Len(StrTitle) * 324
PaperType = intPapertype
PrintDirection = intPrintReportDirection
PageLeft = intPageLeft
PageRight = intPageRight
PageTop = intPageTop
PageBottom = intPageBottom
FieldWidth = intFieldWidth
FieldHeight = intFieldHeight
DetailHeight = Arp1.Printer.PaperHeight - Arp1.ReportHeader.Height - Arp1.ReportFooter.Height - Arp1.PageHeader.Height - Arp1.PageFooter.Height - Arp1.GroupHeader1.Height - Arp1.GroupFooter1.Height - PageTop - PageBottom
'定义值生效
Arp1.PageTopMargin = PageTop
Arp1.PageLeftMargin = PageLeft
Arp1.PageBottomMargin = PageBottom
Arp1.PageRightMargin = PageRight
Arp1.Caption = strCaption
Arp1.Printer.PaperSize = PaperType
Arp1.Printer.Orientation = PrintDirection
Arp1.Detail.Height = DetailHeight
'MsgBox (arp1.Printer.PaperHeight)Set Arp1Title = Arp1.ReportHeader.Controls.add("DDActiveReports.Label")
Arp1Title.Caption = StrTitle
Arp1Title.Font.Name = "黑体"
Arp1Title.Font.Size = 16
Arp1Title.Left = (Arp1.Printer.PaperWidth - TitleWidth) / 2 - PageLeft
Arp1Title.Width = TitleWidth
Set Arp1Title = NothingDim conn As New adodb.Connection
Dim rs As New adodb.Recordset
conn.ConnectionString = "DBQ=data\rsgz.mdb;DRIVER={Microsoft Access Driver (*.mdb)};"
conn.Open
With rs
.Open strtempsql, conn, 1, 1
CurCol = 0
CurRow = 0
If Not (rs.EOF And rs.BOF) Then
For i = 0 To rs.Fields.Count - 1
If CurCol * FieldWidth < 31500 Then
' MsgBox (CurCol * FieldWidth)
'画表头竖线
Set Arp1Line = Arp1.GroupHeader1.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1
Arp1Line.Y2 = FieldHeight
Set Arp1Line = Nothing
'画表头横线
Set Arp1Line = Arp1.GroupHeader1.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1 + FieldWidth
Arp1Line.Y2 = Arp1Line.Y1
Set Arp1Line = Nothing
'填写表头项目
Set Arp1FdName = Arp1.GroupHeader1.Controls.add("DDActiveReports.label")
Arp1FdName.Left = CurCol * FieldWidth
Arp1FdName.Font.Name = "宋体"
Arp1FdName.Font.Size = 10
Arp1FdName.Alignment = 2
Arp1FdName.Caption = rs(i).Name
Set Arp1FdName = Nothing
CurCol = CurCol + 1
Else
Exit For
End If
Next
'补画表头最后一条竖线
Set Arp1Line = Arp1.GroupHeader1.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1
Arp1Line.Y2 = Arp1Line.Y1 + FieldHeight
Set Arp1Line = Nothing
End If
CurCol = 0
CurRow = 0
Do While Not rs.EOF
If CurRow * FieldHeight > DetailHeight Then
Exit Do
End If
CurCol = 0
For i = 0 To rs.Fields.Count - 1
'MsgBox (CurRow * FieldHeight & "/" & CurRow)
If CurCol * FieldWidth < 31500 And CurRow * FieldHeight < 300 Then
'画竖线
Set Arp1Line = Arp1.Detail.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1
Arp1Line.Y2 = Arp1Line.Y1 + FieldHeight
Set Arp1Line = Nothing
'画横线
Set Arp1Line = Arp1.Detail.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1 + FieldWidth
Arp1Line.Y2 = Arp1Line.Y1
Set Arp1Line = Nothing
'填写内容
Set Arp1FdValue = Arp1.Detail.Controls.add("DDActiveReports.field")
Arp1FdValue.Top = CurRow * FieldHeight
Arp1FdValue.Left = CurCol * FieldWidth
Arp1FdValue.Font.Name = "宋体"
Arp1FdValue.Font.Size = 10
Arp1FdValue.Text = rs(i) & ""
Set Arp1FdValue = Nothing
CurCol = CurCol + 1
Else
Exit For
End If
Next
'补画最后一条竖线
Set Arp1Line = Arp1.Detail.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1
Arp1Line.Y2 = Arp1Line.Y1 + FieldHeight
Set Arp1Line = Nothing
rs.MoveNext
CurRow = CurRow + 1
Loop
.close
End With
Set rs = Nothing
conn.close
Set conn = Nothing
'画横线(表格底线)
Set Arp1Line = Arp1.Detail.Controls.add("DDActiveReports.line")
Arp1Line.X1 = 0
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = CurCol * FieldWidth
Arp1Line.Y2 = Arp1Line.Y1
Set Arp1Line = Nothing'打印日期
Arp1.Fieldrq.Text = Date
'打印者
Arp1.Fieldzb.Text = strusername
'页数
Arp1.FieldPageCount.Left = (Arp1.Printer.PaperWidth - Arp1.FieldPageCount.Width - Arp1.FieldToPage.Width - Arp1.Label6.Width) / 2
Arp1.Label6.Left = Arp1.FieldPageCount.Left + Arp1.FieldPageCount.Width
Arp1.FieldToPage.Left = Arp1.Label6.Left + Arp1.Label6.Width
Arp1.FieldPageCount.Text = Arp1.Pages.Count + 1
Arp1.FieldToPage.Text = Arp1.Printer.ToPage + 1
End Sub
我现在的做法是：
设计一张空的报表，设计好表头、字段栏、数据栏、页头、页尾的容器，不增加任何控件
然后动态的创建每一个field(有多少个数据栏就有多少个field)
现在的问题是：
如果数据多了，field的top肯定很大，产生溢出
我知道这种想法是不对的，但我要动态的创建field，因为field的数目不固定，想不出好办法了，下面是源码：
Private Sub ActiveReport_DataInitialize()
Dim strCaption As String
Dim StrTitle As String
Dim Arp1Title As Object
Dim Arp1FdName As Object
Dim Arp1FdValue As Object
Dim Arp1Line As Object
Dim TitleWidth As Integer
Dim PageType As Integer
Dim PrintDirection As Integer
Dim PageLeft As Integer
Dim PageRight As Integer
Dim PageTop As Integer
Dim PageBottom As Integer
Dim FieldWidth As Integer
Dim FieldHeight As Integer
Dim DetailHeight As Integer
Dim CurCol As Integer
Dim CurRow As Integer'获得定义值
strCaption = "报表预览"
StrTitle = strReporttitle
TitleWidth = Len(StrTitle) * 324
PaperType = intPapertype
PrintDirection = intPrintReportDirection
PageLeft = intPageLeft
PageRight = intPageRight
PageTop = intPageTop
PageBottom = intPageBottom
FieldWidth = intFieldWidth
FieldHeight = intFieldHeight
DetailHeight = Arp1.Printer.PaperHeight - Arp1.ReportHeader.Height - Arp1.ReportFooter.Height - Arp1.PageHeader.Height - Arp1.PageFooter.Height - Arp1.GroupHeader1.Height - Arp1.GroupFooter1.Height - PageTop - PageBottom
'定义值生效
Arp1.PageTopMargin = PageTop
Arp1.PageLeftMargin = PageLeft
Arp1.PageBottomMargin = PageBottom
Arp1.PageRightMargin = PageRight
Arp1.Caption = strCaption
Arp1.Printer.PaperSize = PaperType
Arp1.Printer.Orientation = PrintDirection
Arp1.Detail.Height = DetailHeight
'MsgBox (arp1.Printer.PaperHeight)Set Arp1Title = Arp1.ReportHeader.Controls.add("DDActiveReports.Label")
Arp1Title.Caption = StrTitle
Arp1Title.Font.Name = "黑体"
Arp1Title.Font.Size = 16
Arp1Title.Left = (Arp1.Printer.PaperWidth - TitleWidth) / 2 - PageLeft
Arp1Title.Width = TitleWidth
Set Arp1Title = NothingDim conn As New adodb.Connection
Dim rs As New adodb.Recordset
conn.ConnectionString = "DBQ=data\rsgz.mdb;DRIVER={Microsoft Access Driver (*.mdb)};"
conn.Open
With rs
.Open strtempsql, conn, 1, 1
CurCol = 0
CurRow = 0
If Not (rs.EOF And rs.BOF) Then
For i = 0 To rs.Fields.Count - 1
If CurCol * FieldWidth < 31500 Then
' MsgBox (CurCol * FieldWidth)
'画表头竖线
Set Arp1Line = Arp1.GroupHeader1.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1
Arp1Line.Y2 = FieldHeight
Set Arp1Line = Nothing
'画表头横线
Set Arp1Line = Arp1.GroupHeader1.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1 + FieldWidth
Arp1Line.Y2 = Arp1Line.Y1
Set Arp1Line = Nothing
'填写表头项目
Set Arp1FdName = Arp1.GroupHeader1.Controls.add("DDActiveReports.label")
Arp1FdName.Left = CurCol * FieldWidth
Arp1FdName.Font.Name = "宋体"
Arp1FdName.Font.Size = 10
Arp1FdName.Alignment = 2
Arp1FdName.Caption = rs(i).Name
Set Arp1FdName = Nothing
CurCol = CurCol + 1
Else
Exit For
End If
Next
'补画表头最后一条竖线
Set Arp1Line = Arp1.GroupHeader1.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1
Arp1Line.Y2 = Arp1Line.Y1 + FieldHeight
Set Arp1Line = Nothing
End If
CurCol = 0
CurRow = 0
Do While Not rs.EOF
If CurRow * FieldHeight > DetailHeight Then
Exit Do
End If
CurCol = 0
For i = 0 To rs.Fields.Count - 1
'MsgBox (CurRow * FieldHeight & "/" & CurRow)
If CurCol * FieldWidth < 31500 And CurRow * FieldHeight < 300 Then
'画竖线
Set Arp1Line = Arp1.Detail.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1
Arp1Line.Y2 = Arp1Line.Y1 + FieldHeight
Set Arp1Line = Nothing
'画横线
Set Arp1Line = Arp1.Detail.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1 + FieldWidth
Arp1Line.Y2 = Arp1Line.Y1
Set Arp1Line = Nothing
'填写内容
Set Arp1FdValue = Arp1.Detail.Controls.add("DDActiveReports.field")
Arp1FdValue.Top = CurRow * FieldHeight
Arp1FdValue.Left = CurCol * FieldWidth
Arp1FdValue.Font.Name = "宋体"
Arp1FdValue.Font.Size = 10
Arp1FdValue.Text = rs(i) & ""
Set Arp1FdValue = Nothing
CurCol = CurCol + 1
Else
Exit For
End If
Next
'补画最后一条竖线
Set Arp1Line = Arp1.Detail.Controls.add("DDActiveReports.line")
Arp1Line.X1 = CurCol * FieldWidth
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = Arp1Line.X1
Arp1Line.Y2 = Arp1Line.Y1 + FieldHeight
Set Arp1Line = Nothing
rs.MoveNext
CurRow = CurRow + 1
Loop
.close
End With
Set rs = Nothing
conn.close
Set conn = Nothing
'画横线(表格底线)
Set Arp1Line = Arp1.Detail.Controls.add("DDActiveReports.line")
Arp1Line.X1 = 0
Arp1Line.Y1 = CurRow * FieldHeight
Arp1Line.X2 = CurCol * FieldWidth
Arp1Line.Y2 = Arp1Line.Y1
Set Arp1Line = Nothing'打印日期
Arp1.Fieldrq.Text = Date
'打印者
Arp1.Fieldzb.Text = strusername
'页数
Arp1.FieldPageCount.Left = (Arp1.Printer.PaperWidth - Arp1.FieldPageCount.Width - Arp1.FieldToPage.Width - Arp1.Label6.Width) / 2
Arp1.Label6.Left = Arp1.FieldPageCount.Left + Arp1.FieldPageCount.Width
Arp1.FieldToPage.Left = Arp1.Label6.Left + Arp1.Label6.Width
Arp1.FieldPageCount.Text = Arp1.Pages.Count + 1
Arp1.FieldToPage.Text = Arp1.Printer.ToPage + 1
End Sub
给你一个思路，看你能不能解决。
1。将你要打印的内容以临时表的方式写入表中暂存。
2。动态邦写每一个字段也就ok了。
也以免写很多的代码
还有就是用excel来做
比如原来表中有：字段1，字段2，字段3，字段4，字段5，共5个字段
今天要打印出全部的字段，即5个字段
明天只要打字段1，字段3，字段4，3个字段
后天
就是说打几个字段出来不一定
那么我怎么知道要放几个field？所以控件必须是动态添加的临时表绑定字段好象不行吧（字段还是要动态控制）
用excel，我可以输出excel文件，但是表格线怎么用程序控制？怎么控制报表格式？先定好模板？格式不是又定死了吗？
理解有问题，希望能有代码例子，谢谢~~
头大了
比如原来表中有：字段1，字段2，字段3，字段4，字段5，共5个字段
今天要打印出全部的字段，即5个字段
明天只要打字段1，字段3，字段4，3个字段
后天
就是说打几个字段出来不一定
那么我怎么知道要放几个field？所以控件必须是动态添加的临时表绑定字段好象不行吧（字段还是要动态控制）
用excel，我可以输出excel文件，但是表格线怎么用程序控制？怎么控制报表格式？先定好模板？格式不是又定死了吗？
理解有问题，希望能有代码例子，谢谢~~
头大了
所以也不存在格式，也就是说这一代码都一样的。
如果不行可能只有用printer来定。
With frmPrint.rstPrint
If Not .eof Then
eof = False
Fields("Name") = !M_NAME
Fields("NQ") = !NQ
Fields("JB") = !JB
Fields("WY") = !WY
Fields("WD") = !WD
Fields("TQ") = !TQ
Fields("BJ") = !BJ
Fields("XJ") = !XJ
Fields("SJ") = !SJ
Fields("Amount") = Format(!Amount, "###,##0.00")
Fields("Dept_Name") = !Dept_Name
.MoveNext
Else
eof = True
End If
End WithEnd SubPrivate Sub ActiveReport_Initialize()
On Error Resume Next
Fields.Add "Name"
Fields.Add "NQ"
Fields.Add "JB"
Fields.Add "WY"
Fields.Add "WD"
Fields.Add "TQ"
Fields.Add "BJ"
Fields.Add "XJ"
Fields.Add "SJ"
Fields.Add "Amount"
Fields.Add "Dept_Name"
frmPrint.rstPrint.MoveFirst
End SubPrivate Sub ActiveReport_ReportStart()
Me.Printer.RenderMode = 1
lbTitle.Width = Me.PrintWidth
lbTitle.Caption = "" & frmPrint.strTitle
End Sub
With frmPrint.rstPrint
If Not .eof Then
eof = False
Fields("Name") = !M_NAME
Fields("NQ") = !NQ
Fields("JB") = !JB
Fields("WY") = !WY
Fields("WD") = !WD
Fields("TQ") = !TQ
Fields("BJ") = !BJ
Fields("XJ") = !XJ
Fields("SJ") = !SJ
Fields("Amount") = Format(!Amount, "###,##0.00")
Fields("Dept_Name") = !Dept_Name
.MoveNext
Else
eof = True
End If
End WithEnd SubPrivate Sub ActiveReport_Initialize()
On Error Resume Next
Fields.Add "Name"
Fields.Add "NQ"
Fields.Add "JB"
Fields.Add "WY"
Fields.Add "WD"
Fields.Add "TQ"
Fields.Add "BJ"
Fields.Add "XJ"
Fields.Add "SJ"
Fields.Add "Amount"
Fields.Add "Dept_Name"
frmPrint.rstPrint.MoveFirst
End SubPrivate Sub ActiveReport_ReportStart()
Me.Printer.RenderMode = 1
lbTitle.Width = Me.PrintWidth
lbTitle.Caption = "" & frmPrint.strTitle
End Sub