Поэтому в коде RowHeightFiting1 и была "Подгонка", чтоб данный код можно было использовать с минимальными доработками.
А в коде RowHeightFiting2, естественно, нужно было самому выставить необходимые значения ширин серёдинки и краёв.
Однако, по большому счёту, Sokl абсолютно прав. Данную тему читают не только Sokl и tolikt, а ещё много людей. Которым может быть лень вникать в суть всех постов с самого начала. А нужен только окончательный рабочий код, чтоб только Copy-Paste в свой проект.
Поэтому сначала отдельно выкладываю код MiddEdgeWidth с комментариями. Он определяет ширину в пт середины и краёв для стиля Normal в активной рабочей книге.
А после - RowHeightFiting3 - итоговый код подгонки высоты объединённой ячейки с учётом текущего стиля Normal.
Код: Выделить всё
Sub MiddEdgeWidth()
' Определение ширины (в пт) единицы символа ("середины") и краёв ("боковушек") для текущего стиля Normal
' Для этого определения используется самая последняя ячейка, но можно использовать любую, в данном случае не важно
Dim MyNormalMiddleWidth, MyNormalEdgeWidth
Dim c1, c2, w1, w2 'временные переменные ширин столбцов в симв и пт
Dim MyTempCell As Range
Dim OldColWidth 'ширина временной ячейки до манипуляций (чтобы потом вернуть обратно, на всякий случай)
Set MyTempCell = Cells(65536, 256)
OldColWidth = MyTempCell.ColumnWidth
c1 = 10 ' ширину в симв можно установить любую, но точно не менее 1 (где нельзя реально определить нужные нам данные),
c2 = 15 ' и лучше более 3 и целочисленные (для уменьшения влияния ошибки округления..... впрочем, в коде эта возможная ошибка учитывается)
' Установка ширины ячейки в симв и получения получившихся реальных ширин в симв и пт
MyTempCell.ColumnWidth = c1
c1 = MyTempCell.ColumnWidth 'хотя, если c1 целое, то эта строка не нужна
w1 = MyTempCell.Width
MyTempCell.ColumnWidth = c2
c2 = MyTempCell.ColumnWidth 'то же, если c2 целое, то эта строка не нужна
w2 = MyTempCell.Width
' Вычисление ширин "середины" и "боковушек" (пришлось вспомнить решение системы из 2-х простых уравнений за 5-й класс школы)
MyNormalMiddleWidth = Format((w2 - w1) / (c2 - c1), "#0.00") ' тут Format - для округления возможной ошибки вычисления
MyNormalEdgeWidth = Format((c2 * w1 - c1 * w2) / (c2 - c1), "#0.00")
' Возврат в исходное состояние
MyTempCell.ColumnWidth = OldColWidth
'Вывод сообщения о текущем стиле Normal и его ширинах
MsgBox "Шрифт текущего стиля - " & Application.StandardFont & _
Chr(10) & "Его размер - " & Application.StandardFontSize & _
Chr(10) & Chr(10) & "Ширина ""середины"" - " & MyNormalMiddleWidth & _
Chr(10) & "Ширина ""краёв"" - " & MyNormalEdgeWidth
End SubКод: Выделить всё
Sub RowHeightFiting3()
' Объединённая ячейка должна быть активной!!!
' Если требуется подобрать высоту для неактивной ячейки, то нужно переменной MyRanAdr присвоить ПОЛНЫЙ адрес области объединённой ячейки '(Напр, MyRanAdr = "D4:G7" вместо строки MyRanAdr = ActiveCell.MergeArea.Address)
Application.ScreenUpdating = False
Dim MyNormalMiddleWidth, MyNormalEdgeWidth
Dim c1, c2, w1, w2 'временные переменные ширин столбцов в симв и пт
Dim MyTempCell As Range
Dim OldColWidth
Set MyTempCell = Cells(65536, 256)
OldColWidth = MyTempCell.ColumnWidth
c1 = 10 ' ширину в симв можно установить любую, но точно не менее 1 (где нельзя реально определить нужные нам данные),
c2 = 15 ' и лучше более 3 и целочисленные (для уменьшения влияния ошибки округления..... впрочем, в коде эта возможная ошибка учитывается)
MyTempCell.ColumnWidth = c1
c1 = MyTempCell.ColumnWidth
w1 = MyTempCell.Width
MyTempCell.ColumnWidth = c2
c2 = MyTempCell.ColumnWidth
w2 = MyTempCell.Width
MyNormalMiddleWidth = Format((w2 - w1) / (c2 - c1), "#0.00")
MyNormalEdgeWidth = Format((c2 * w1 - c1 * w2) / (c2 - c1), "#0.00")
MyTempCell.ColumnWidth = OldColWidth
Dim MyRanAdr As String
Dim MergeAreaTotalHeight, NewRH
Dim MergeAreaFirstCellColWidth, MergeAreaFirstCellColHeight
MyRanAdr = ActiveCell.MergeArea.Address 'адрес области с объединённой ячейкой
MergeAreaTotalHeight = Range(MyRanAdr).Height ' высота всей объединённой ячейки в ед. пт
MergeAreaFirstCellColWidth = Range(MyRanAdr).Cells(1, 1).EntireColumn.ColumnWidth ' ширина первого столбца в объединённой ячейке
MergeAreaFirstCellColHeight = Range(MyRanAdr).Cells(1, 1).EntireRow.RowHeight ' высота первой строки в объединённой ячейке
Range(MyRanAdr).Cells(1, 1).ColumnWidth = (Range(MyRanAdr).Width - MyNormalEdgeWidth) / MyNormalMiddleWidth 'установка ширины первого столбца объед. ячейки равной общей ширине объед. ячейки '''БЕЗ ПОДГОНКИ!!!
Range(MyRanAdr).WrapText = True
Range(MyRanAdr).MergeCells = False
Range(MyRanAdr).Cells(1, 1).EntireRow.AutoFit
NewRH = Range(MyRanAdr).Cells(1, 1).EntireRow.RowHeight
Range(MyRanAdr).MergeCells = True
Range(MyRanAdr).Cells(1, 1).EntireColumn.ColumnWidth = MergeAreaFirstCellColWidth
If NewRH < MergeAreaTotalHeight Then 'если новая высота меньше изначальной, то оставляем изначальную высоту!
Range(MyRanAdr).Cells(1, 1).EntireRow.RowHeight = MergeAreaFirstCellColHeight
Else
Range(MyRanAdr).Cells(1, 1).EntireRow.RowHeight = NewRH - (MergeAreaTotalHeight - MergeAreaFirstCellColHeight) ' для 1st строки в объед.ячейке
End If
'Range(MyRanAdr).EntireRow.RowHeight = NewRH / Range(MyRanAdr).Rows.Count 'для равной высоты всех строк в объед.ячейке (вместо предыдущего блока If)
Application.ScreenUpdating = True
End Sub1. Очевидно, что при большом количестве объединённых ячеек, у которых нужно установить правильную высоту, в одной процедуре нет необходимости каждый раз определять коэффициенты середины и краёв ячейки для текущего стиля Normal. И, чтоб ускорить процесс, процедуру с определением этих коэффициентов (тут - MiddEdgeWidth) лучше выделить в отдельную программку и прогнать её только один раз вначале процесса, присвоив их значения соответствующим переменным для выполнения процедуры подбора высоты ячейки.
2. Метод Autofit выставляет высоту строки по "своему усмотрению".
Т.е. например: Шрифт Times New Roman Cyr 10пт визуально прекрасно входит в строку высотой 10.50. Но Autofit высталяет высоту 12.75. А, напр., в документах с большим количеством строк эти "навязчивые излишества" мешают - искажают (увеличивают) размер документа (количество печатных страниц).
Поэтому я на практике применяю сначала Autofit к какой-либо пустой ячейке той же строки, что и первая строка объединённой ячейки и отформатированной так же, как и текущая объединённая. И после Autofit объединённой ячейки выставляю высоту строки за минусом разницы между первоначальной высотой ячейки и высотой пустой ячейки.
Т.к. необходимость этой манипуляции зависит от желания пользователя, то в данном коде эта процедура не отражена!
То же самое, если изначальная высота объединённой ячейки была больше, чем после Autofit. Но т.к., если объединённая ячейки состоит из нескольких низеньких строк, а сам текст входит целиком в ячейку, то после Autofit может возникнуть ошибка (из-за попытки установить высоту первой строки в виде отрицательного значения). Поэтому лучше оставить изначальную высоту ячейки. И эта процедура отражена в коде (блок If в конце).
Вроде, понятно объяснил....