VF报表指令的完整格式:
REPORT FORM FileName1 | ? [ENVIRONMENT] [Scope]
[FOR lExpression1] [WHILE lExpression2] [NOOPTIMIZE]
[RANGE nStartPage [, nEndPage]]
[HEADING cHeadingText] [SUMMARY] [NORESET] [PLAIN]
[NOCONSOLE | OFF] [PDSETUP]
[NAME ObjectName]
[OBJECT oReportListener | TYPE iExpression]
[TO OutputDestination [NODIALOG]]
[PREVIEW [PreviewDestination] [NOWAIT] [WINDOW WindowName]]
OBJECT oReportListener:这个参数很重,他提供了VF报表在运行时的监听功能。有兴趣的朋友可以仔细阅读一下VF提供ReportListener这个类,帮助文件有详细说明,下面我就针对Report转Excel做简单的介绍。
在Report转Excel过程中会用ReportListener这个类的三个Event、一个Method。一般报表结构都有分页头、明细、页尾三个区域,在看下面的内容前要对VF报表结构有一定了解。
Event:
AfterBand:是报表在处理每个区域之后触发的事件
BeforeBand:是报表在处理每个区域之前触发的事件
EvaluateContents:是报表在处理显示字段时触发的事件
Method:
Render:这个函数负责报表所有显示内容的处理,包括文字、图形、字段。
知道这些用途后我们就可以用ReportListener派生一个新的类,利用这些功能去做自己想做事情。下面是一段Report转Excel代码提供给大家,这对那些想了解VF报表和Excel外部控制的朋友来说很有参考价值。有兴趣的朋友可以对代码进行优化,还有很大的优化空间。
代码直接在VF 9.0下执行,可以用报表向导生成一个报表。然后用下面的代码执行即可。
Select ReportDataAlias
loListener = CreateObject("XlsListenner", ReportFileName)
loListener.ReportOutXls()
Define Class XlsListenner As ReportListener
lbUnit = 10000 / 72 &&用报表度量单位与Excel度量单位(磅)的转换,VF报表度量除10000得到的是英寸,1英寸=72磅
GrpSpaceHeight = 2082.916 &&这个值是自己计算出来的,是报表每个之间的横栏的高度
XlsOutRow = 0 &&记录输出到第几行
XlsFileName = "" &&要生成的Excel文件名
ReportFileName = "" &&VF报表文件名
m_Ljvalue = 0 &&类定义Sum函数的累计变量
XlscolWidthScale = 1 &&Excel宽与高的度量是不同的,这个变量用于记录宽的与磅之间的比例
ReportInfoAlias = "" &&用于记录报表信息的Alias
objExcel = Null &&以下是Excel对象存储变量
objWorkBook = Null
objWorkSheet = Null
Procedure ReportOutXls()
This.ListenerType = -1
Report Form (This.ReportFileName) For Preview Object This
Endproc
Procedure LabelOutXls()
This.ListenerType = -1
Label Form (This.ReportFileName) Object This
Endproc
Procedure DoStatus(cMessage) &&去除进度提示
Nodefault
Endproc
Procedure Init(rptName As String, xlsName As String) &&对报表结构进行分析
Local lcAlias
lcAlias = Alias()
This.ReportFileName = rptName
This.XlsFileName = xlsName
Use (rptName) In 0 Alias rptAlias
This.OpenExcel()
Select rptAlias
Locate For objtype = 1 And objcode = 53
If Found()
lnHPosMargin = Round(hpos / (This.lbUnit), 0)
lnVPosMargin = Round(Height / (This.lbUnit), 0)
Else
lnHPosMargin = 0
lnVPosMargin = 0
Endif
This.SetPageMargin(lnHPosMargin, lnHPosMargin, lnVPosMargin, lnVPosMargin, lnVPosMargin, lnVPosMargin)
This.m_Ljvalue = 0
Select a.*, b.*, Recno() As xlsRow, Recno() As xlsBCol, Recno() As xlsECol From (;
Select objcode As Grpcode, Recno() As GrpRecNum, ;
this.Sum(Iif(objtype = 9, Height, 0)) - Height As GrpVpos, ;
Height As GrpHeight;
From rptAlias Where objtype = 9;
) a Inner Join (;
Select Recno() As RecNum, objtype, objcode, Expr, vpos, hpos, Height, Width ;
From rptAlias Where Inlist(objtype, 5,6,7,8) ;
) b On a.GrpVpos < b.vpos And b.vpos + b.Height < a.GrpVpos + a.GrpHeight ;
Order By b.vpos Into Table csr_grp_info
Use In rptAlias
Replace GrpVpos With GrpVpos - (GrpRecNum - 2) * This.GrpSpaceHeight ;
vpos With vpos - (GrpRecNum - 2) * This.GrpSpaceHeight ;
All In csr_grp_info
Replace GrpVpos With Round(GrpVpos / (This.lbUnit), 1) ;
GrpHeight With Round(GrpHeight / (This.lbUnit), 1) ;
vpos With Round(vpos / This.lbUnit, 1) ;
Height With Round(Height / This.lbUnit, 1);
hpos With Round(hpos / (This.lbUnit) / This.XlscolWidthScale, 2);
Width With Round(Width / (This.lbUnit) / This.XlscolWidthScale, 2);
All In csr_grp_info
Delete For Inlist(objtype, 6, 7) And (Height > Width Or Height = 0 Or Width = 0 ) In csr_grp_info
Pack In csr_grp_info
Replace Height With 14 For Inlist(objtype, 5, 8) And Height < 14 In csr_grp_info
Select vpos, Max(Height) As Height From csr_grp_info Where Inlist(objtype, 5, 8);
Group By vpos Into Cursor csr_tz_height
Select csr_tz_height
Scan
lnVpos = vpos
lnHeight = Height
Replace Height With lnHeight For vpos = lnVpos In csr_grp_info
Endscan
Use In csr_tz_height
Select *, vpos As VSpace, Recno() As xlsRow From (;
Select 0 As Y, Grpcode, GrpRecNum, objtype, RecNum, vpos ;
From csr_grp_info ;
Union;
Select 1 As Y, Grpcode, GrpRecNum, objtype, RecNum, vpos + Height As vpos ;
From csr_grp_info;
)a Order By vpos, RecNum Into Table csr_vspace
lnTzvalue = 0
lnVpos = 0
lnSpace = 0
Select csr_vspace
Scan
If vpos - lnVpos != 0
lnSpace = vpos - lnVpos
Else
lnSpace = lnTzvalue
Endif
Replace VSpace With lnSpace
lnTzvalue = lnSpace
lnVpos = vpos
Endscan
Select Distinct Grpcode, GrpRecNum, vpos, Grpcode As xlsRow From csr_vspace Into Table csr_grp_xlsrow
Select Distinct Grpcode, GrpRecNum From csr_vspace Into Cursor csr_grp
Select csr_grp
Scan
lnGrpcode = Grpcode
lnGrpRecNum = GrpRecNum
Select csr_grp_xlsrow
Locate For Grpcode = lnGrpcode And GrpRecNum = lnGrpRecNum
If Found()
lnRecno = Recno() - 1
Replace xlsRow With Recno("csr_grp_xlsrow") - lnRecno ;
For Grpcode = lnGrpcode And GrpRecNum = lnGrpRecNum In csr_grp_xlsrow
Endif
Endscan
Use In csr_grp
Select csr_grp_xlsrow
Scan
lnGrpcode = Grpcode
lnVpos = vpos
lnXlsRow = xlsRow
Replace xlsRow With lnXlsRow For Grpcode = lnGrpcode And vpos = lnVpos In csr_vspace
Endscan
Use In csr_grp_xlsrow
Select csr_vspace
Scan For Y = 1
lnRecnum = RecNum
lnXlsRow = xlsRow
Replace xlsRow With lnXlsRow For RecNum = lnRecnum In csr_grp_info
Endscan
Select Distinct Grpcode, GrpRecNum, VSpace, xlsRow ;
From csr_vspace Order By Grpcode, xlsRow Into Cursor csr_V_space
Use In csr_vspace
Select Distinct RecNum, Width, hpos From csr_grp_info Order By hpos Into Table csr_hspace
Select Distinct hpos From csr_hspace ;
Union;
Select Max(hpos+Width) As hpos From csr_hspace;
into Cursor csr_hpos
lnPreHpos = 0
Select csr_hpos
Scan
lnHpos = hpos
Replace Width With lnHpos - hpos For lnPreHpos < hpos + Width And hpos + Width < lnHpos In csr_hspace
lnPreHpos = lnHpos
Endscan
Use In csr_hpos
Select csr_hspace
Scan
lnRecnum = RecNum
lnWidth = Width
Replace Width With lnWidth For RecNum = lnRecnum In csr_grp_info
Endscan
Select Distinct *, hpos As HSpace, Recno() As xlsCol From (;
Select hpos From csr_hspace;
Union;
Select hpos + Width As hpos From csr_hspace;
)a Order By hpos Into Table csr_hSpace_tz
Use In csr_hspace
lnHpos = 0
Select csr_hSpace_tz
Scan
Replace HSpace With hpos - lnHpos, xlsCol With Recno()
lnHpos = hpos
Endscan
Select a.RecNum, b.xlsCol As xlsBCol, c.xlsCol As xlsECol ;
From csr_grp_info a Inner Join csr_hSpace_tz b On a.hpos = b.hpos;
Inner Join csr_hSpace_tz c On Round(a.hpos + a.Width, 3) = c.hpos Into Cursor csr_xls_cols
Select csr_xls_cols
Scan
lnRecnum = RecNum
lnXlsBcol = xlsBCol
lnXlsEcol = xlsECol
Replace xlsBCol With lnXlsBcol, xlsECol With lnXlsEcol For RecNum = lnRecnum In csr_grp_info
Endscan
Use In csr_xls_cols
Select csr_hSpace_tz
Scan
This.objWorkSheet.Columns(xlsCol).ColumnWidth = HSpace
Endscan
Use In csr_hSpace_tz
Select &lcAlias
Endproc
Procedure Destroy()
Local lcAlias
lcAlias = Alias()
This.CloseExcel()
If Used("csr_v_space")
Use In csr_V_space
Endif
If Used("csr_grp_info")
Use In csr_grp_info
Endif
If !Empty(lcAlias)
Select &lcAlias
Endif
Endproc
Procedure OpenExcel() &&调用Excel
This.objExcel = Createobject("Excel.Application")
This.objExcel.Visible = .F.
This.objWorkBook = This.objExcel.Workbooks.Add()
This.objWorkSheet = This.objWorkBook.WorkSheets(1)
This.objWorkSheet.Select
This.objExcel.ActiveWindow.DisplayGridlines = .F.
This.XlscolWidthScale = Round(This.objWorkSheet.Range("A1").Width / This.objWorkSheet.Columns(1).ColumnWidth, 3)
Endproc
Function SetPageMargin(pLeftMargin As Integer, pRightMargin As Integer, pTopMargin As Integer, pBottomMargin As Integer;
, pHeaderMargin As Integer, pFooterMargin As Integer) &&设置Excel页边距
With This.objWorkSheet.PageSetup
.LeftMargin = pLeftMargin
.TopMargin = pTopMargin
.HeaderMargin = pHeaderMargin
.RightMargin = 1
.FooterMargin = pBottomMargin
.BottomMargin = pBottomMargin + 55
Endwith
Endfunc
Procedure CloseExcel() &&关闭Excel并保存文件
If Type("this.XlsFileName") == "C" And !Empty(This.XlsFileName)
If File(This.XlsFileName, 1)
Delete File (This.XlsFileName)
Endif
This.objWorkBook.SaveAs(This.XlsFileName)
This.objWorkBook.Close()
This.objExcel.Quit()
Else
This.objExcel.Visible = .T.
Endif
Endproc
Function Sum(fld) As Integer
This.m_Ljvalue = This.m_Ljvalue + fld + Iif(Recno() > 2, This.GrpSpaceHeight, 0)
Return This.m_Ljvalue
Endfunc
oProgFrom = Null
Procedure BeforeReport &&启用进度显示
This.oProgFrom = Createobject("ProcessForm")
This.oProgFrom.pb.Max = Reccount()
This.oProgFrom.pb.Value = 0
This.oProgFrom.Caption = "Report To Excel"
This.oProgFrom.Show()
Endproc
Procedure AfterReport &&关闭进度显示
This.oProgFrom.Release()
Endproc
Procedure AfterBand(nBandObjCode, nFRXRecNo)
Local lcAlias, lisFound
If This.PageTotal < 1
Return
Endif
lcAlias = Alias()
lnXlsRow = 0
Select csr_V_space
Locate For Grpcode = nBandObjCode And GrpRecNum = nFRXRecNo
lisFound = Found()
If lisFound
Do While lisFound
This.objWorkSheet.Rows(This.XlsOutRow + xlsRow).RowHeight = VSpace
lnXlsRow = xlsRow
Continue
lisFound = Found()
Enddo
If nBandObjCode == 4
This.oProgFrom.pb.Add()
Endif
Endif
This.XlsOutRow = This.XlsOutRow + lnXlsRow
Select &lcAlias
Endproc
Function XlsColName(pColNumber As Integer) &&数字转Excel列名
Local divVal, divMod, cHeight
divMod = Mod( pColNumber, 26 )
divVal = Int( pColNumber / 26 )
If divVal <= 0
Return Chr( 65 + divMod )
Endif
cHeight = This.XlsColName( divVal - 1 )
Return cHeight + Chr( 65 + divMod )
Endfunc
Function XlsCellAddr(pRowNumber As Integer, pColNumber As Integer)
Local lcColName As String
lcColName = This.XlsColName(pColNumber - 1)
If Type("pRowNumber") = "N" And pRowNumber > 0
Return lcColName + Alltrim(Str(pRowNumber, 5, 0))
Endif
Return lcColName
Endfunc
PrePageNo = 1
Procedure Render(nFRXRecNo, nLeft,nTop,nWidth,nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage)
Local lcAlias, lcCells
lcAlias = Alias()
If This.PageTotal < 1
Return
Endif
Select csr_grp_info
Locate For RecNum = nFRXRecNo
If Found()
If This.PrePageNo != This.PageNo
This.AddPageBreak()
This.PrePageNo = This.PageNo
Endif
Do Case
Case objtype = 6
lcCells = This.XlsCellAddr(This.XlsOutRow + xlsRow, xlsBCol)+":"+This.XlsCellAddr(This.XlsOutRow + xlsRow, xlsECol)
This.objWorkSheet.Application.Range(lcCells).Interior.Color = Rgb(0, 0, 0)
Case Inlist(objtype, 5, 8)
This.objWorkSheet.Application.Cells(This.XlsOutRow + xlsRow, xlsBCol + 1).Value = Strconv(cContentsToBeRendered, 6)
If xlsBCol + 1 <> xlsECol
lcCells = This.XlsCellAddr(This.XlsOutRow + xlsRow, xlsBCol+1)+":"+This.XlsCellAddr(This.XlsOutRow + xlsRow, xlsECol)
This.objWorkSheet.Application.Range(lcCells).Merge()
Endif
Endcase
Endif
Select &lcAlias
Endproc
Procedure AddPageBreak()
This.objWorkSheet.HPageBreaks.Add(This.objWorkSheet.Rows(This.XlsOutRow + 1))
Endproc
Enddefine
Define Class Progress Form as Form
Add Object pb as ProgressBar
BorderStyle = 2
AutoCenter = .t.
Width = 500
Height = 50
pb.left = 5
pb.top = 10
pb.Width = 500 - 10
pb.height = 25
ControlBox = .f.
AlwaysOnTop = .t.
BackColor = Rgb(255,255,220)
EndDefine
Define class ProgressBar as OleControl
OleClass = "MSComctlLib.ProgCtrl.2"
BorderStyle = 1
Scrolling = 0
Step = 1
Function Add
this.Value = Iif(this.Value >= this.Max, this.Value, this.Value + 1)
If Mod(this.Value, this.Step) = 0
this.Refresh()
EndIf
EndFunc
EndDefine