[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

lwwvb

其实这个东西是旧瓶装新酒了.是一个很久很久的例子改良的.创意来自那个例子.[em01]

lwwvb

这个免线工具就在上面。不要哭。。。[em05]

lwwvb

希望大家关注一下。这是一个不错的东西。

lwwvb

下载不了的朋友，请到www.accessoft.com注册一个用户，然后再打开上面的链接，就OK了。[em05]

lwwvb

不明白，字段增长？