Линии подчёркивания сразу под всеми полями (TextBox-ами) раздела отчётаПодробности: Рисуем линии подчёркивания под всеми TextBox-ами любого раздела отчёта (или только с определённым префиксом в названии) 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 'Длина префикса (если указан) 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
Результат виден только в режиме Print Preview т.к. иначе событие Print не возникает. |
|||
L.E. 04.09.2021 |