MyTetra Share
Делитесь знаниями!
Линии подчёркивания сразу под всеми полями (TextBox-ами) раздела отчёта
19.07.2018
19:08
Раздел: VBA - Access - msa.polarcom.ru - 08 Отчеты


Линии подчёркивания сразу под всеми полями (TextBox-ами) раздела отчёта

Подробности:
  ControlType Property:
  https://msdn.microsoft.com/en-us/library/office/aa224135%28v=office.11%29.aspx
  Report.Line Method:
  https://msdn.microsoft.com/en-us/library/office/ff198297.aspx

Рисуем линии подчёркивания под всеми TextBox-ами любого раздела отчёта (или только с определённым префиксом в названии)
Сильно экономит время при создании отчётов с подчёркнутыми полями: СФ, ТОРГ-12, УПД и т.п.


Public Sub RepFieldsUnderLine(objReportSection As Section, Optional strFieldPrefix As String = "", Optional lColor&)

'es - 01.06.2016 - 08.12.2017 L.E.

'Рисуем линии подчёркивания под всеми TextBox-ами любого раздела отчёта

'(или только с опред. префиксом в названии)

'--------------------------------------------------------------------------

'Аргументы:

' objReportSection - ссылка на раздел отчёта

' strFieldPrefix - Префикс названий элементов - не обязательный, и при пропуске

' - будут обработаны все элементы типа TextBox (Текстовое поле)

' lColor - Цвет (По умолчанию = 0 чёрный)

'--------------------------------------------------------------------------

'Вешается на событие Print (Печать) любой области отчета - например так:

' RepFieldsUnderLine ReportFooter, "txt"

' - Будут подчёркнуты все TextBox-ы с "txt" в начале названия элемента

'--------------------------------------------------------------------------


Dim objCtrl As Control 'обьект элемент управления

Dim StartX As Integer 'координата начала линии по оси X

Dim EndX As Integer 'координата конца линии по оси X

Dim StartY As Integer 'координата начала линии по оси Y

Dim EndY As Integer 'координата конца линии по оси Y

Dim l As Integer 'Длина префикса (если указан)

Dim lColor 'Цвет


On Error GoTo RepFieldsUnderLine_Err

If strFieldPrefix <> "" Then

l = Len(strFieldPrefix) 'Длина префикса (если указан)

End If

With objReportSection

.Parent.DrawWidth = 1 'Толщина линии (тут можно поиграться если нужно) _

по умолчанию = 1 (...The default is 1, or 1 pixel wide.)

'Перебор всех элементов внутри раздела отчёта

For Each objCtrl In .Controls

If objCtrl.ControlType = acTextBox Then 'Только если это TextBox

'если это текстовое с указанным префиксом в названии

If Mid(objCtrl.Name, 1, l) = strFieldPrefix Then

' Координаты начала и конца по оси X

StartX = objCtrl.Left

EndX = StartX + objCtrl.Width

' Координаты начала и конца по оси Y

StartY = objCtrl.Top + objCtrl.Height

EndY = StartY

' Рисуем горизонтальную под текущим TextBox-ом

.Parent.Line (StartX, EndY)-(EndX, EndY), lColor

End If

End If

Next

End With


RepFieldsUnderLine_Bye:

Exit Sub


RepFieldsUnderLine_Err:

'MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & _

"в процедуре: RepFieldsUnderLine", vbCritical, "Error in module modReports"

Err.Clear

Resume RepFieldsUnderLine_Bye

End Sub





Пример эксплуотации:


Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)

Dim lColor&

'lColor = RGB(127, 127, 127) ' Тёмно-Серый

lColor = RGB(172, 181, 191) ' Светлее

RepFieldsUnderLine Detail, "txt", lColor


End Sub



Private Sub ReportHeader_Print(Cancel As Integer, PrintCount As Integer)

'Заголовок отчёта (Header):

'Линии под полями с префиксом txt

RepFieldsUnderLine ReportHeader, "txt"

End Sub



Private Sub ReportFooter_Print(Cancel As Integer, PrintCount As Integer)

'Примечание отчёта (Footer):

'Линии под полями с префиксом txt

RepFieldsUnderLine ReportFooter, "txt"

End Sub





В результате - все поля в заголовке и примечании отчёта подчёркнуты.

Picture

Результат виден только в режиме Print Preview т.к. иначе событие Print не возникает.

Назад ToTop

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования