Линии подчёркивания сразу под всеми полями (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&) 'Рисуем линии подчёркивания под всеми TextBox-ами любого раздела отчёта '(или только с опред. префиксом в названии) '-------------------------------------------------------------------------- 'Аргументы: ' objReportSection - ссылка на раздел отчёта ' strFieldPrefix - Префикс названий элементов - не обязательный, и при пропуске ' - будут обработаны все элементы типа TextBox (Текстовое поле) ' lColor - Цвет (По умолчанию = 0 чёрный) '-------------------------------------------------------------------------- 'Вешается на событие Print (Печать) любой области отчета - например так: ' RepFieldsUnderLine ReportFooter, "txt" ' - Будут подчёркнуты все TextBox-ы с "txt" в начале названия элемента '--------------------------------------------------------------------------
Dim objCtrl As Control Dim StartX As Integer Dim EndX As Integer Dim StartY As Integer Dim EndY As Integer 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 If Mid(objCtrl.Name, 1, l) = strFieldPrefix Then StartX = objCtrl.Left EndX = StartX + objCtrl.Width StartY = objCtrl.Top + objCtrl.Height EndY = StartY .Parent.Line (StartX, EndY)-(EndX, EndY), lColor End If End If Next End With
RepFieldsUnderLine_Bye: Exit Sub
RepFieldsUnderLine_Err: "в процедуре: 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(172, 181, 191) RepFieldsUnderLine Detail, "txt", lColor
End Sub
Private Sub ReportHeader_Print(Cancel As Integer, PrintCount As Integer) 'Линии под полями с префиксом txt RepFieldsUnderLine ReportHeader, "txt" End Sub
Private Sub ReportFooter_Print(Cancel As Integer, PrintCount As Integer) 'Линии под полями с префиксом txt RepFieldsUnderLine ReportFooter, "txt" End Sub
В результате - все поля в заголовке и примечании отчёта подчёркнуты.
Результат виден только в режиме Print Preview т.к. иначе событие Print не возникает.
|