Тип связи субъекта с процессом и субъект в одном столбце

Текущая ситуация

Структурирование информации позволяет "разложить все по полочкам" в голове человека, быстрей и проще понять предоставляемую информацию. Такой же подход требуют себе задачи, решаемые через программные продукты, например, Business Studio. В то же время, при разработке отчетов это означает, что каждой выделенной структуре, например, в таблице, требуется отдельный столбец. В некоторых случаях это бывает неудобно по причине нехватки места на листе. И если совместить данные некоторых столбцов в одном определенным способом, то читабельность документа от этого не уменьшиться.

Постановка задачи

В отчете формата Word по процессу в таблице со столбцами процессов, субъектов процесса и типа связи субъекта с процессом сделать так, чтобы тип связи показывался не отдельным столбцом, а в столбце с субъектом. При этом:

  1. При выводе в HTML (HTML-публикация или Business Studio Portal) ссылка на субъект должна остаться ссылкой, а название вида связи должно быть черным цветом, как это было и в столбце с названием вида связи.
  2. При выводе в Word название типа связи должно быть цветом, отличным от названия субъекта для большей читабельности (например, серый цвет) и курсивом.

Название субъекта и название типа связи должно быть разделено символом "/".

Исходные данные

Решение описывается с момента, когда в шаблоне отчета создана необходимая привязка типа "Список", которую можно видеть таблицей.

Рисунок 1. Вид необходимой привязки типа "Список" в шаблоне отчета
Рисунок 2. Вид выполненного отчета формата Word до решения задачи
Рисунок 3. Вид выполненного отчета в HTML-публикации до решения задачи

Концепция решения

После того, как отчет будет сформирован, будем запоминать текст в каждой ячейке столбца "Тип связи" и добавлять его к тексту соседней ячейки столбца "Субъект" в нужном оформлении. Столбец "Тип связи" после этого удаляется.

Шаги решения

Кодом VBA:

  • для каждой ячейки столбца "Тип субъекта" заполнить текст ячейки;
  • вставить в конец ячейки той же строки столбца "Субъект" и указать необходимые параметры шрифта, который будет вставлен позже, при форматировании необходимо учесть направление формирование отчета (Word, HTML);
  • в той же ячейке вставить разделительное выражение и запомненный ранее текст с типом связи.

После окончания переноса всех типов связей удалить столбец "Тип связи" и поправить таблицу к обычному виду.

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

Результат

 

Рисунок 4. Вид выполненного отчета формата Word после решения задачи кодом VBA
Рисунок 5. Вид выполненного отчета в HTML-публикации после решения задачи кодом VBA

 

« ПредыдущаяНа уровень вышеСледующая »
Driven by DokuWiki