[LWWVB]报表免线工具！！极力推荐！！！

lwwvb

http://www.office-cn.net/forum.p ... jQ4MTI5fDc1fDIyNDU3
这个免线工具就在上面。不要哭。。。[em05]

主要的类模块代码

Option Compare Database
Option Explicit

Dim Ctl As Control
Dim i As Integer

Dim x() As Long
Dim p As Integer
Dim MaxX As Long
Dim MaxBound As Integer

Dim LastRptName As String
Dim LastSection As AcSection

Public OutWidth As Integer
Public InWidth As Integer

'在报表中要画线的段的print事件 调用此参数
Public Sub DrawGrid(rpt As Report, DrawSection As AcSection, Optional DrawLR As Boolean = True, Optional DrawTop As Boolean = False, Optional DrawBottom As Boolean = False)
  ''''假如要绘制的对象或段不同，就重查找相应的控件位置
  If LastRptName <> rpt.Name Or LastSection <> DrawSection Then
    LastRptName = rpt.Name
    LastSection = DrawSection

    MaxBound = rpt.Section(DrawSection).Controls.Count
    ReDim x(MaxBound)

    p = 0: MaxX = 0
    For i = 1 To MaxBound
      Set Ctl = rpt.Section(DrawSection).Controls(i - 1)
      x(i) = Ctl.Left + Ctl.Width
      If x(i) > MaxX Then MaxX = x(i): p = i
    Next i


  End If

  rpt.DrawWidth = InWidth
  For i = 1 To MaxBound
    If i <> p Then rpt.Line (x(i), 0)-(x(i), rpt.Height)
  Next i

  rpt.DrawWidth = OutWidth
  If DrawLR Then
    rpt.Line (0, 0)-(0, rpt.Height)  '''画左线
    rpt.Line (rpt.Width, 0)-(rpt.Width, rpt.Height) ''画右线
  End If

  If DrawTop Then rpt.Line (0, 0)-(rpt.Width, 0)  '''画上线


  '''画底线
  If DrawBottom = False Then rpt.DrawWidth = InWidth
  rpt.Line (0, rpt.Height)-(rpt.Width, rpt.Height)

End Sub

achieve202

谢了

2007-cjl

顶

fjwen

谢谢分享。收下好好学习一下。

flyshare

看不到,怎么才能看得到?

假斯文

谢谢楼主

wuyu1623

看不了啊，这个连接到的不是本论坛上的吗？

希望斑竹能贴上来

xdcow

看看

chengtingfeng

非常不错，正是我们需要的，谢谢！！！

nzlwc_fsb

收下，顶。