1

Тема: Макрос для форматирования заголовка таблицы

Доброго времени суток!

Работаем в Word 2013.

Возникла такая проблема: имеется документ Word, в который пользователь вставляет таблицы. Заголовки таблиц должны быть отформатированы определенным образом (серый фон, жирный текст). Если последняя строка заголовка содержит цифры, то эта строка серым не выделяется.
Для соблюдения единообразия и ускорения процедуры было предложено написать макрос.

Пока в документ вставляли простые таблицы (без объединенных ячеек) - макрос работал замечательно, но, когда пользователи стали вставлять таблицы, в заголовках которых имеются объединенные ячейки, макрос стал выдавать ошибку.

Как нужно изменить макрос, чтобы он работал?

В приложении - пример файла с таблицами.

P.S. Прошу табуретками в меня не кидать - ибо не программист я ни разу,
а макрос написать помогли старшие товарищи, но даже они не знают, как решить проблему
sad.

Текст макроса:

Sub tab_header()

    Dim i, j As Integer
   
    'если в таблице выделение начинается с первой строки
    If Selection.Information(wdStartOfRangeRowNumber) = 1 Then
        Selection.Style = ActiveDocument.Styles("Заг_Таб")
        Selection.Shading.Texture = wdTextureNone
        Selection.Shading.ForegroundPatternColor = wdColorAutomatic
        Selection.Shading.BackgroundPatternColor = -603923969
        Selection.Rows.HeadingFormat = wdToggle
    End If
 
    'выделить последнюю строку заголовка
    Selection.Collapse Direction = wdCollapseStart
    ActiveDocument.Tables(ActiveDocument.Range(ActiveDocument.Range.Start, Selection.Start).Tables.Count).Rows(Selection.Information(wdEndOfRangeRowNumber) - 1).Select
   
    'будем проверять содержимое ячеек последней строки заголовка
    i = 0
    j = 0
    For Each Cell In Selection.Cells
        i = i + Cell.ColumnIndex
        'в ячейке может быть текст
        On Error GoTo End_Sub
        'если в ячейке число
        If CInt(Left(Cell.Range.Text, Len(Cell.Range.Text) - 2)) = Cell.ColumnIndex Then
           j = j + CInt(Left(Cell.Range.Text, Len(Cell.Range.Text) - 2))
        End If
    Next Cell

End_Sub:
   
    If i = j Then
        Selection.Shading.Texture = wdTextureNone
        Selection.Shading.ForegroundPatternColor = wdColorAutomatic
        Selection.Shading.BackgroundPatternColor = wdColorAutomatic
    End If
   
    Selection.Collapse Direction = wdCollapseStart
   
End Sub

Post's attachments

Примеры таблиц.docx 12.29 Кб, 5 скачиваний с 2015-05-28 

You don't have the permssions to download the attachments of this post.