[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

kevinho

好东东！谢谢版主！

hgt

好，顶啊

yangzn

真历害（代码相当简略）我原来手工绘线，画了我不少的时间,谢谢分享

tmtony

非常不错，Lwwvb常出精品：）

swo

很好的东西

lwwvb

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

jmhwm

厉害!!

wewyhy

什么时候来个2003版

情比金坚

  它说我没有资格浏览昵!!!!