ACCESS报表控件整理代码.docx

Option Compare Database'========================================='作用: 为报表画线,统一各控件的宽度.高度.和间隙'1.取主体和页面页眉第一个控件的高度height 为标准,设置其他控件的高度. '2.以主体的每一个控件的宽度width 为标准,设置页面页眉相对应控件的宽度'3.连接主体和页面页眉的控件,使其隙一致. '==========================================Public Function ReportSheet(rpt As Report, _LeftControl As control, _ RightControl As control, _ Optional RowsOfPage As Integer, _ Optional sTYLE As Integer = 0, _Optional HasColumnHeader As Boolean = True) '报表画线设置'On Error Resume NextDim intI As IntegerDim lngTop As Long '表格上边距，即报表页眉的高度Dim lngBottom As Long '表格下边距，报表页眉的高度 ＋主体节高度×每页要显示的记录数Dim lngLeft As Long '表格左边距，第一个控件的左边距Dim lngRight As Long '表格右边距，最后一个控件的左边距＋最后一个控件的宽度Dim lngRowHeight As Long '行高，即主体节高度Dim lngacDetaiHeight As Long '主体高度Dim lngSumH As Long '主体多行的总高度 + 页面页眉的高度(线上端起始位置) Dim lngYmKjheight As Long '页面页眉最低层(标题)行中的第一个控件的高度Dim lngRows As Long Dim lngRowTop As LongDim lngBottomMax As Long Dim lngDim ctl As control With rptFor Each ctl In .Section(acPageHeader).ControlsIf ctl.Tag = "ymym" Then '页面页眉的标题行要在Tag 中作出特殊标记ymymlngYmKjheight = ctl.Height 'ctl.Top Exit ForEnd IfNextlngRowHeight = .Section(acDetail).Height ' 行高：主体节高度lngTop = .Section(acPageHeader).Height ' 设上边距为页面页眉高度， 为防止报表没有页面页眉所以代码单独一行If .Page = 1 Then lngTop = lngTop + .Section(acHeader).Height ' 第一页再加上报表页眉高度，为防止报表没有报表页眉所以代码单独一行lngBottomMax = .Section(acPageFooter).Height ' 页面页脚高度，为防止报表没有页面页脚所以代码单独一行lngacDetaiHeight = .ScaleHeight - lngBottomMax ' 下边距lngBottomMax = .ScaleHeight - lngBottomMax ' 报表高度减去页面页脚高度得到最大允许的下边距.DrawWidth = 5 End WithlngRows = Int((lngBottomMax - lngTop) / lngRowHeight) ' 当前页面能容纳的行数If RowsOfPage > 0 ThenIf RowsOfPage < lngRows Then lngRows = RowsOfPage ' 如果指定的行数不超过能容纳的行数，取指定行数End IflngBottom = lngTop + lngRowHeight * lngRows ' 根据行数计算表格下边距If HasColumnHeader Then 'lngRows = lngRows + 1lngTop = lngTop - lngYmKjheight 'lngRowHeight ' 页面页眉的高度 减页面页眉控件高度(行高)'lngacDetaiHeight = lngacDetaiHeight - lngYmKjheight End IflngLeft = rpt.ScaleWidthFor Each ctl In rpt.Section(acPageFooter).ControlsIf ctl.Tag = "ymyj2" Then '页面页脚的第一行ymyj 第二行 ymyj2 要在 Tag 中作出特殊标记lngacDetaiHeight = lngacDetaiHeight + ctl.Height + ctl.top Exit ForEnd IfNextFor Each ctl In rpt.Section(acDetail).ControlsIf lngLeft > ctl.left Then lngLeft = ctl.left ' 表格左边距If lngRight < ctl.left + ctl.Width Then lngRight = ctl.left + ctl.Width ' 表格右边距If sTYLE <> 1 Then rpt.Line (ctl.left, lngTop)-(ctl.left, lngBottom) ' 画竖线Next'下面加 50 ，是把最后一行线下移50，和左右竖线延长50，是为了防止最后一排控件的高度太小，与线太靠近了，是为了更好看一点。

If sTYLE <> 1 Then rpt.Line (lngRight, lngTop)-(lngRight, lngacDetaiHeight + 50) ' 在最右边画竖线If sTYLE <> 1 Then rpt.Line (lngLeft, lngTop)-(lngLeft, lngacDetaiHeight + 50) '在最左边画竖线'画横线If sTYLE <> 2 ThenIf HasColumnHeader Thenrpt.Line (lngLeft, lngTop)-(lngRight, lngTop) '画标题顶横线For intI = 0 To lngRows'主体多行的总高度 + 页面页眉的高度(线上端起始位置) lngSumH = lngRowHeight * intI + lngTop + lngYmKjheight rpt.Line (lngLeft, lngSumH)-(lngRight, lngSumH)ElseNextFor intI = 0 To lngRows'主体多行的总高度 + 页面页眉的高度(线上端起始位置) lngSumH = lngRowHeight * intI + lngToprpt.Line (lngLeft, lngSumH)-(lngRight, lngSumH)Next End Ifrpt.Line (lngLeft, lngacDetaiHeight + 50)-(lngRight, lngacDetaiHeight + 50) '画底端横线End If End FunctionPublic Sub SameRoportFormat(rptName As String) '报表整齐设计Dim lngZtKj As Long '主体控件高度Dim lngYmKj As Long '页面页眉控件高度Dim zname As StringDim zleft As Single '控件的左 Dim zwidth As Single '控件的宽'Dim zheight As Single '控件的高'Dim yheight As SingleDim myRpt As ReportDim ctr As control '参照控件Dim ctl As control '页面页眉页脚控件DoCmd.OpenReport rptName, acViewDesign'取主体和页面页眉第一各控件的height Set myRpt = Access.Reports(rptName) For Each ctr In myRpt.主体.ControlsIf TypeName(ctr) <> "Line" And ctr.Tag = "zt" Then lngZtKj = ctr.Height'tt = ctr.Top Exit ForEnd IfNextFor Each ctr In myRpt.页面页眉.ControlsIf TypeName(ctr) <> "Line" And ctr.Tag = "ymym" ThenlngYmKj = ctr.Height Exit ForEnd IfNext'设主体各Textbox 之间的间隙一致zleft = 0For Each ctr In myRpt.主体.Controls ctr.left = zleftctr.Height = lngZtKj ctr.Tag = "zt"ctr.top = 0 '设置主体中控件的顶部与主体的距离（要稍许大一点，能不被主体本身遮住为好）zleft = ctr.left + ctr.WidthNext'设置页面页眉的Label 与主体各Textbox 的宽度一致For Each ctr In myRpt.主体.Controlszname = ctr.Name zwidth = ctr.Width zleft = ctr.leftFor Each ctl In myRpt.页面页眉.ControlsIf ctl.Tag = "ymym" Or ctl.Tag = "left" Then '页面页眉的第一行的特殊标记ywidth = ctl.WidthIf Split(ctl.Name, "_")(0) = zname Then '控件取名特殊化ctl.left = zleftctl.Width = zwidth 'ctl.TextAlign = 2 ctl.Height = lngYmKj ctl.Tag = "ymym"ctl.top = 1953 '设置页面页眉中控件的顶部与页眉的距离（要稍许大一点，能不被页眉本身遮住为好）Exit For End IfEnd IfNextFor Each ctl In myRpt.页面页脚.ControlsIf ctl.Tag = "ymyj" Then '页面页脚的第一行的特殊标记ywidth = ctl.Width'MsgBox Split(ctl.Name, "_")(1)If Split(ctl.Name, "_")(0) = zname Then '控件取名特殊化ctl.left = zleftctl.Width = zwidth 'ctl.TextAlign = 2 ctl.Height = lngYmKj ctl.Tag = "ymyj"本身遮住为好）ctl.top = 0 '设置页面页脚中控。