|
好像是t小宝的作品……请自行创建模块处理。- Option Compare Database
- Option Explicit
- '************************************************************************************************
- '参数说明:
- 'ReportSheet (rpt, LeftControl, RightControl, RowsOfPage, Style)
- ' rpt:必选,报表名称
- ' LeftControl:必选,最左边控件名称,用于确定左边距。
- ' RightControl:必选,最右边控件名称,用于确定右边距。
- ' RowsOfPage:可选,为每页指定行数
- ' Style:可选,0为方框,1为仅画横线,2为仅画竖线。
- '调用说明:
- '在报表中“打印页前”事件中调用:=ReportSheet (rpt, [左控件名称], [右控件名称], RowsOfPage, Style)
- '*************************************************************************************************
- Public Function ReportSheet(rpt As Report, LeftControl As Control, RightControl As Control, _
- Optional RowsOfPage As Integer, Optional Style As Integer = 0)
- On Error Resume Next
- Dim intI As Integer
- Dim lngTop As Long
- Dim lngBottom As Long
- Dim lngLeft As Long
- Dim lngRight As Long
- Dim lngRowHeight As Long
-
- Dim lngRows As Long
- Dim lngRowTop As Long
- Dim lngBottomMax As Long
-
- Dim ctl As Control
-
- With rpt
- lngRowHeight = .Section(acDetail).Height
- lngTop = .Section(acPageHeader).Height
- If .Page = 1 Then lngTop = lngTop + .Section(acHeader).Height
- lngBottomMax = .Section(acPageFooter).Height
- lngBottomMax = .ScaleHeight - lngBottomMax
- End With
- lngRows = Int((lngBottomMax - lngTop) / lngRowHeight)
- If RowsOfPage > 0 Then
- If RowsOfPage < lngRows Then lngRows = RowsOfPage
- End If
- lngBottom = lngTop + lngRowHeight * lngRows
-
- lngLeft = rpt.ScaleWidth
- For Each ctl In rpt.Section(acDetail).Controls
- If 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
- If Style <> 1 Then rpt.Line (lngRight, lngTop)-(lngRight, lngBottom)
-
-
- If Style <> 2 Then
- For intI = 0 To lngRows
- rpt.Line (lngLeft, lngTop + lngRowHeight * intI)-(lngRight, lngTop + lngRowHeight * intI)
-
- Next
- End If
-
- End Function
复制代码 |
|