ACCESS报表控件整理代码

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 LongDim lngRowTop As LongDim lngBottomMax As LongDim lngDim ctl As controlWith rptFor Each ctl In .Section(acPageHeader).ControlsIf ctl.Tag = "ymym" Then '页面页眉的标题行要在Tag中作出特殊标记ymymlngYmKjheight = ctl.Height 'ctl.TopExit 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 = 5End 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 - lngYmKjheightEnd IflngLeft = rpt.ScaleWidthFor Each ctl In rpt.Section(acPageFooter).ControlsIf ctl.Tag = "ymyj2" Then '页面页脚的第一行ymyj第二行ymyj2要在Tag中作出特殊标记lngacDetaiHeight = lngacDetaiHeight + ctl.Height + ctl.topExit 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 + lngYmKjheightrpt.Line (lngLeft, lngSumH)-(lngRight, lngSumH)NextElseFor intI = 0 To lngRows'主体多行的总高度+ 页面页眉的高度(线上端起始位置)lngSumH = lngRowHeight * intI + lngToprpt.Line (lngLeft, lngSumH)-(lngRight, lngSumH)NextEnd Ifrpt.Line (lngLeft, lngacDetaiHeight + 50)-(lngRight, lngacDetaiHeight + 50) '画底端横线End IfEnd 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'取主体和页面页眉第一各控件的heightSet myRpt = Access.Reports(rptName)For Each ctr In myRpt.主体.ControlsIf TypeName(ctr) <> "Line" And ctr.Tag = "zt" ThenlngZtKj = ctr.Height'tt = ctr.TopExit ForEnd IfNextFor Each ctr In myRpt.页面页眉.ControlsIf TypeName(ctr) <> "Line" And ctr.Tag = "ymym" ThenlngYmKj = ctr.HeightExit ForEnd IfNext'设主体各Textbox之间的间隙一致zleft = 0For Each ctr In myRpt.主体.Controlsctr.left = zleftctr.Height = lngZtKjctr.Tag = "zt"ctr.top = 0 '设置主体中控件的顶部与主体的距离（要稍许大一点，能不被主体本身遮住为好）zleft = ctr.left + ctr.WidthNext'设置页面页眉的Label与主体各Textbox的宽度一致For Each ctr In myRpt.主体.Controlszname = zwidth = ctr.Widthzleft = ctr.leftFor Each ctl In myRpt.页面页眉.ControlsIf ctl.Tag = "ymym" Or ctl.Tag = "left" Then '页面页眉的第一行的特殊标记ywidth = ctl.WidthIf Split(, "_")(0) = zname Then '控件取名特殊化ctl.left = zleftctl.Width = zwidth'ctl.TextAlign = 2ctl.Height = lngYmKjctl.Tag = "ymym"ctl.top = 1953 '设置页面页眉中控件的顶部与页眉的距离（要稍许大一点，能不被页眉本身遮住为好）Exit ForEnd IfEnd IfNextFor Each ctl In myRpt.页面页脚.ControlsIf ctl.Tag = "ymyj" Then '页面页脚的第一行的特殊标记ywidth = ctl.Width'MsgBox Split(, "_")(1)If Split(, "_")(0) = zname Then '控件取名特殊化ctl.left = zleftctl.Width = zwidth'ctl.TextAlign = 2ctl.Height = lngYmKjctl.Tag = "ymyj"ctl.top = 0 '设置页面页脚中控件的顶部与页眉的距离（要稍许大一点，能不被页眉本身遮住为好）Exit ForEnd IfEnd IfNextFor Each ctl In myRpt.页面页脚.ControlsIf ctl.Tag = "ymyj2" Then '页面页脚的第二行的特殊标记ywidth = ctl.Width'MsgBox Split(, "_")(1)If Split(, "_")(0) = zname Then '控件取名特殊化ctl.left = zleftctl.Width = zwidth'ctl.TextAlign = 2ctl.Height = lngYmKjctl.Tag = "ymyj2"ctl.top = lngYmKj '设置页面页脚中控件的顶部与页眉的距离（要稍许大一点，能不被页眉本身遮住为好）Exit ForEnd IfEnd IfNextNextmyRpt.主体.Height = lngZtKj '设置主体表中控件的顶端离页面页眉的行高（即第一行的行高）myRpt.页面页眉.Height = lngYmKj '+ 80 '设置主体表中控件的行高（即第二行到结束的行高）myRpt.页面页脚.Height = lngYmKj '+ 80'设置完成保存一下DoCmd.Close acReport, rptName, acSaveYes'再打开看看是否成功End Sub在报表的VBE中复制下列代码,即可.Private Sub Report_Page()'hs 表示行数, 1表示样式(1 大概表示竖线,2 大概表示横线),False 表示标题不加线ReportSheet Me, Me.FId, Note ', hs , 1, FalseEnd Sub。