Excel: автоматическое изменение высоты строки с объединенными ячейками - VB

Const c_Border_Width = 0.7    ' дополнительная ширина границы между ячейками (для автоопределения высоты объединенной ячейки)
'------------------------------------------------------------------------------------------
' Автоматическое определение высоты строки для указанной ячейки,
' в том числе - объединенной (по столбцам и/или по строкам).
' Достаточно высокие строки не изменяются.
'------------------------------------------------------------------------------------------
Function AutoFit_Height(p_oCell)
Dim h_row_original, h_row_set
Dim arr_h_row()
Dim w_col_original, w_col_total
Dim i_oCol, cnt_rows, n_rows, h_row, flg_excl, k, i, j, s
   
   AutoFit_Height = -1  ' код неуспешного завершения
   If UCase(TypeName(p_oCell)) <> "RANGE" Then Exit Function ' неверный параметр
   
   AutoFit_Height = 1   ' код успешного завершения
   
   If Not p_oCell.MergeCells Then ' ячейка не часть объединенной ячейки
      h_row_original = p_oCell.RowHeight   ' запомним первоначальную высоты строки
      p_oCell.EntireRow.AutoFit            ' подберем высоту строки по содержанию
      ' но если строка стала меньше начальной, то восстановим исходную высоту
      ' (высота могла быть настроена по другим объединенным ячейкам в этой строке)
      If h_row_original > p_oCell.RowHeight Then p_oCell.RowHeight = h_row_original
      Exit Function
   End If ' ячейка не часть объединенной ячейки
   
   ' --- Дальше работа с объединенной ячейкой ----------------------------------------
   
   With p_oCell.MergeArea   ' Работа с объединенной ячейкой ---------------------------
      cnt_rows = .Rows.Count  ' кол-во строк в объединенной ячейке
      
      ' Сохранение исходной высоты строки/строк объединенной ячейки ------------------
      If cnt_rows = 1 Then ' ячейка в одну строку
         h_row_original = .Rows(1).RowHeight   ' запомним первоначальную высоты строки
      Else ' ячейка в несколько строк
         h_row_original = 0         ' суммарная первоначальная высота строк
         ReDim arr_h_row(cnt_rows)  ' установим размер массива высот строк
         For i = 1 To cnt_rows   ' цикл по всем строкам объединенной ячейки
            arr_h_row(i) = .Rows(i).RowHeight               ' первоначальная высота очередной строки
            h_row_original = h_row_original + arr_h_row(i)  ' суммарная первоначальная высота строк
         Next   ' цикл по всем строкам объединенной ячейки
         
      End If   ' ячейка в одну строку ?
      
      ' Определение нужной высоты для содержимого объединенной ячейки ----------------
      w_col_original = .Columns(1).ColumnWidth  ' запомним ширину первой колонки
      If .Columns.Count = 1 Then    ' объединено одна колонка
         w_col_total = w_col_original
      Else    ' Если объединено несколько колонок
         ' Подсчитаем ширину объединенной ячейки
         w_col_total = c_Border_Width * (.Columns.Count - 1)   ' дополнение (на границы) к сумме ширин колонок
         For Each i_oCol In .Columns
            w_col_total = w_col_total + i_oCol.ColumnWidth
         Next
      End If   ' Если объединено несколько колонок
      
      .MergeCells = False              ' снимем объединение
      .Columns(1).ColumnWidth = w_col_total  ' установим расчитанную ширину колонки
      .Rows(1).AutoFit               ' автоподбор высоты строки
      h_row_set = .Rows(1).RowHeight   ' запомним нужную высоту строки
      .Columns(1).ColumnWidth = w_col_original  ' восстановим ширину первой колонки
      .MergeCells = True               ' восстановим объединение
      
      ' Установка нужной высоты / восстановление прежней -----------------------------
      If .Rows.Count = 1 Then ' ячейка в одну строку
         .RowHeight = IIf(h_row_original > h_row_set, h_row_original, h_row_set)
      Else ' ячейка в несколько строк
         .Rows(1).RowHeight = arr_h_row(1)   ' восстановим высоту первой строки
         If h_row_original < h_row_set Then  ' исходная суммарная высота меньше, чем расчетная
            ' надо менять высоту строк ----------- >>>>
            ' исключаем те строки, высота которых больше, чем нужно (в среднем)
            n_rows = cnt_rows    ' кол-во строк, на которые надо распределить высоту
            Do 'цикл исключения достаточно высоких строк и перераспределения изменения на оставшиеся
               flg_excl = False  ' признак того, что была исключена хоть одна строка
               h_row = h_row_set / n_rows    ' расчетная высота каждой из оставшихся строк (средняя)
               For i = 1 To cnt_rows
                  If arr_h_row(i) > h_row Then ' исходная высота больше, чем надо
                     flg_excl = True   ' признак того, что была исключена хоть одна строка
                     h_row_set = h_row_set - arr_h_row(i)   ' уменьшим распределяемую высоту
                     n_rows = n_rows - 1                    ' уменьшим кол-во изменяемых строк
                     arr_h_row(i) = -1                      ' больше эту строку не учитывать
                  End If ' исходная высота больше, чем надо
               Next
            Loop While flg_excl 'цикл исключения достаточно высоких строк и перераспределения изменения на оставшиеся
            h_row = h_row_set / n_rows    ' расчетная высота каждой из оставшихся строк (средняя)
            For i = 1 To cnt_rows               ' цикл по всем строкам объединенной ячейки
               If arr_h_row(i) > 0 Then         ' строка не исключена из обработки
                  .Rows(i).RowHeight = h_row
                  h_row_set = h_row_set - .Rows(i).RowHeight   ' уменьшим остаток распределяемой высоты
               End If ' строка не исключена из обработки
            Next   ' цикл по всем строкам объединенной ячейки
            If h_row_set > 0 Then   ' если не вся требуемая высота расределена
               .Rows(1).RowHeight = .Rows(1).RowHeight + h_row_set   ' добавим к первой строке
            End If  ' если не вся требуемая высота расределена
         End If  ' исходная суммарная высота меньше, чем расчетная ?
      End If   ' ячейка в одну строку ?
      
   End With   ' Работа с объединенной ячейкой
   
End Function   ' AutoFit_Height