[access报表][报表]报表跨节垂直居中例子

时　间:2009-03-09 08:21:12
作　者:t小宝   ID：4598  城市：柳州
摘　要:[报表]报表跨节垂直居中例子
正　文:

很多用惯EXCEL的朋友在制作报表时喜欢用EXCEL的思路，比如垂直居中，而在ACCESS中没有垂直居中属性，特别是跨节的垂直居中，很麻烦！
下面例子用一种不常用但很简单的方法实现报表中跨节的垂直居中。

代码:
Function PrintTextToCenterByGroup(rpt As Report, lNumber As Long, lCounts As Long, _
    sText As String, lLeft As Long, Optional sFName As String, Optional iSize As Integer, _
    Optional bFBold As Boolean) As Long
   
'功能说明:在有分组的报表中把文本(一般是用于分组的字段)每组只打印一行，并在组的垂直范围内居中
'参数说明:
'rpt:     报表本身
'lNumber: 基于组的连续的序号(即每个组都从1开始连续编号). 在主体上放一文本框,数据源为"=1",运行总和属性为"工作组之上",即可获得基于组的连续序号
'lCounts: 每个组的总记录数. 在组页眉或页脚上主一文本框,数据源为"=Count(*)",即可获得每个组的总记录数
'sText:   每个组要打印的文本
'lLeft:   打印的文本的左边距
'sFName:  打印的文本的字体,可选
'iSize:   打印的文本的大小,可选
'bFBold:  打印的文本是否加粗,可选
'使用方法:在报表主体节的格式化事件中使用
'      如：PrintTextToCenterByGroup Me, Me.序号, Me.组记录数, Me.产品类别, 350, "黑体", 14, True
'作    者:t小雨(tcl013@126.com)
'创建日期:2008年11月15日
'更新日期:2008年11月19日
    Dim iTxtHeight As Integer
   
    If Len(sFName) <> 0 Then rpt.FontName = sFName
    If iSize > 0 Then rpt.FontSize = iSize
    rpt.FontBold = bFBold
   
    iTxtHeight = rpt.TextHeight(sText) - iSize * 6.1
    '获得字符实际高度，须在设置字体大小代码之后。
    '由于TextHeight 方法返回的字符高度包括上面和下面的前导空间，并且空间高度随字体大小比例变化，
    '代码 大小 * 6.1 获得空间高度（参数6.1是手动测试的，只是大致准确）。
   
    If lCounts / 2 + 0.5 = lNumber Then
        '如果当前记录序号等于总记录数除以2+0.5，则总记录数为奇数，当前记录为最中间的一条记录
        '比如总记录数为5，则中间的记录序号应为3，5/2+0.5=3
       
        rpt.CurrentY = (rpt.主体.Height - iTxtHeight) / 2
        '当前行记录为中间记录时，设置打印起点使打印字符显示在本行的中间
    ElseIf lCounts / 2 = lNumber Then
        '当记录总数为偶数时，最中间的有两条记录
        '如果当前记录序号等于总记录数除以2，则当前记录为中间两条记录的第一条
        '比如总记录数为4，则最中间的两条记录应为2和3，第一条记录序号就是2，4/2=2
       
        rpt.CurrentY = rpt.主体.Height - iTxtHeight / 2
        '当前记录为两条中间记录的第一条时，设置打印起点为主体高度减去字符高度的一半，这样只显示字符的上半部分
    ElseIf lCounts / 2 + 1 = lNumber Then
        '如果当前记录序号等于总记录数除以2+1，则当前记录为中间两条记录的第二条
       
        rpt.CurrentY = 0 - iTxtHeight / 2
        '两条中间记录的第二条，设置打印起点为0减去字符高度的一半，只显示字符的下半部分
        '这样一来，第一条在主体的下方显示字符的上半部分，第二条在主体的上方显示字符的下半部分，就造成了跨行的假象！
       
    Else
        Exit Function
        '不符合上述3种条件的记录不打印，退出过程
    End If
    rpt.CurrentX = lLeft
   
    rpt.Print sText
    '打开字符
   
End Function

例   子:

点击这里下载