Структурирование информации позволяет "разложить все по полочкам" в голове человека, быстрей и проще понять предоставляемую информацию. Такой же подход требуют себе задачи, решаемые через программные продукты, например, Business Studio. В то же время, при разработке отчетов это означает, что каждой выделенной структуре, например, в таблице, требуется отдельный столбец. В некоторых случаях это бывает неудобно по причине нехватки места на листе. И если совместить данные некоторых столбцов в одном определенным способом, то читабельность документа от этого не уменьшиться.
В отчете формата Word по процессу в таблице со столбцами процессов, субъектов процесса и типа связи субъекта с процессом сделать так, чтобы тип связи показывался не отдельным столбцом, а в столбце с субъектом. При этом:
Название субъекта и название типа связи должно быть разделено символом "/".
Решение описывается с момента, когда в шаблоне отчета создана необходимая привязка типа "Список", которую можно видеть таблицей.
После того, как отчет будет сформирован, будем запоминать текст в каждой ячейке столбца "Тип связи" и добавлять его к тексту соседней ячейки столбца "Субъект" в нужном оформлении. Столбец "Тип связи" после этого удаляется.
Кодом VBA:
После окончания переноса всех типов связей удалить столбец "Тип связи" и поправить таблицу к обычному виду.
Sub ПослеВыполненияОтчета(ob As Variant, app As Variant) 'ВВОДНАЯ 'Название закладки, формирующей нужную таблицу Dim Bookmark As String Bookmark = "Подпроцессы_и_исполнител_83cdcd34" 'Номер столбца с названием Субъекта Dim ColumnSubject As Integer ColumnSubject = 3 'Номер столбца с типом связи Dim ColumnTypeLink As Integer ColumnTypeLink = 4 'текст, являющийся разделителем между Субъектом и типом связи Dim Separator As String Separator = " / " Dim TypeLinkWordColorRGB 'цвет текста типа связи в Word TypeLinkWordColorRGB = RGB(127, 127, 127) Dim TypeLinkHTMLColorRGB 'цвет текста типа связи в Word TypeLinkHTMLColorRGB = RGB(0, 0, 0) 'Служебные Dim CellLinkText As String Dim TableTypeLink As Table 'Определяем направление вывода (отдельный файл или HTML) Dim HTMLCreate As Boolean HTMLCreate = Application.ActiveDocument.Variables("BSHtml").Value 'True или False 'ПРОЦЕДУРНАЯ ЧАСТЬ If BookmarkIs(Bookmark) Then 'если закладка есть в документе Set TableTypeLink = Application.ActiveDocument.Bookmarks(Bookmark).Range.Tables(1) countRow = TableTypeLink.Rows.Count 'количество строк таблицы For i = 2 To countRow On Error Resume Next 'игнор error 5991, если какие-то ячейки имеют вертикальное объединение CellLinkText = CellTextClean(TableTypeLink.Cell(i, ColumnTypeLink).Range.Text) If Len(CellLinkText) Then 'если тип связи указан TableTypeLink.Cell(i, ColumnSubject).Select 'переходим к нужной ячейке Selection.EndKey 'переходим к концу выделенной ячейки If HTMLCreate Then 'если создается HTML Selection.Font.Color = TypeLinkHTMLColorRGB 'задаем цвет Selection.Font.Underline = wdUnderlineNone 'убираем подчеркивание гиперссылки Else 'если создается файл Word Selection.Font.Color = TypeLinkWordColorRGB 'wdColorRed 'задаем новый цвет Selection.Font.Italic = wdToggle 'курсив End If Selection.TypeText Text:=Separator & CellLinkText 'дописываем вид связи End If Next i '2. Удаляем лишнее и наводим красоту в таблице 'Запоминаем ширину столбца с Типом связи TableTypeLink.Columns(ColumnTypeLink).Select ColumnTypeLinkWidth = Selection.Columns.PreferredWidth 'Запоминаем ширину столбца с Комментарием TableTypeLink.Columns(ColumnTypeLink + 1).Select ColumnCommentWidth = Selection.Columns.PreferredWidth 'Удаляем столбец с названием типа связи TableTypeLink.Columns(ColumnTypeLink).Delete 'Расширяем таблицу на 100% страницы TableTypeLink.PreferredWidthType = wdPreferredWidthPercent TableTypeLink.PreferredWidth = 100 If HTMLCreate Then 'если создается HTML 'уменьшение ширины первого столбца TableTypeLink.Columns(1).PreferredWidth = _ TableTypeLink.Columns(1).PreferredWidth / 4 Else 'Задаем ширину столбца Комментария TableTypeLink.Columns(ColumnTypeLink).PreferredWidth = _ ColumnTypeLinkWidth + ColumnCommentWidth + 5 End If End If End Sub Function BookmarkIs(BookmarkName As String) As Boolean 'Проверка на корректность названия привязки Dim Bkm As Bookmark 'переменная типа Закладка BookmarkIs = False 'сначала считаем, что нужной закладки нет For Each Bkm In ActiveDocument.Bookmarks 'перебираем все закладки в документе If Bkm.Name = BookmarkName Then 'если нашли закладку с нашим именем BookmarkIs = True 'отмечаем, что закладка есть End If Next End Function Function CellTextClean(CellText As String) As String 'Убирается 2 последних символа в предоставленном тексте 'Используется для очистки текста ячейки от 2х последних служебных символов Dim countCharClean As Integer countCharClean = 2 ' кол-во символов для удаления If Len(CellText) > countCharClean Then 'если символов больше, чем будем удалять 'убираем последние символы (для текста ячейки - это чистый текст) CellTextClean = Left$(CellText, (Len(CellText) - countCharClean)) Else 'иначе ничего не удаляем, а возвращаем то, что получили CellTextClean = CellText End If End Function