В модуле отчета
Option Compare Database
Option Explicit
Dim vlineData(30) As String
Private Sub Report_Open(Cancel As Integer)
'Заполняем при открытии отчета массив зарание расположенными элементами (именами)
'В данном случае имена линий
'Последний элемент должен быть пустой строкой ""
vlineData(0) = "Линия13"
vlineData(1) = "Линия14"
vlineData(2) = "Линия15"
vlineData(3) = "Линия16"
vlineData(4) = "Линия17"
vlineData(5) = ""
End Sub
Private Sub ОбластьДанных_Print(Cancel As Integer, PrintCount As Integer)
'Вызываем функцию без ограничения высоты линий
Call DrawVertLines(Me, vlineData)
End Sub
\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
В отдельном модуле
Option Compare Database
Option Explicit
'Фукция DrawVertLines. Рисование вертикальных линий в отчете.
'rep - указатель на отчет
'vlineData массив имен элементов из отчета (например имена линий разделяющих заголовки столбцов столбцы)
'последний элемент должен быть пустой строкой
'TopCtrl и BottomCtrl - имена элементов из отчета для ограничения линий по высоте (если эти аргументы пропущены,
'то высота линий будет равна высоте раздела отчета при форматировании которого применяется данная функция)
Public Function DrawVertLines(rep As Report, vlineData() As String, Optional TopCtrl As String = "", Optional BottomCtrl As String = "")
Dim i As Long
Dim x1 As Long
Dim y1 As Long
Dim x2 As Long
Dim y2 As Long
On Error Resume Next
If Len(TopCtrl) <> 0 Then
y1 = rep.Controls(TopCtrl).Top
Else
y1 = 0
End If
If Len(BottomCtrl) <> 0 Then
y2 = rep.Controls(BottomCtrl).Top
Else
y2 = 10000
End If
For i = 0 To 30
If Len(vlineData(i)) > 0 Then
x1 = rep.Controls(vlineData(i)).Left
x2 = x1
rep.Line (x1, y1)-(x2, y2), 0
Else
Exit For
End If
Next i
End Function
|