Excel:
Для объединенных ячеек не работает ни перенос по словам, ни автоматический подбор высоты строки???
Спрашивается: что мне-то делать, если обрезание строки крайне нежелательно!!!
Подскажите, пжлста...
Автовысота объединенной ячейки?
Модератор: Naeel Maqsudov
Сам сделал... Правда косячно - искусственным способом... Если есть какие-либо штатные варианты, выскажите, пожалуйста...
Я делала задачу, где нужно было работать с объединенными ячейками. Перенос по словам устанавливается так же, как и в обычной ячейке. А вот подбор высоты действительно не работает, его я делала тоже искуственным образом. Возможно, вам это и не подойдет - решение ищется в зависимости от поставленной задачи, я выходила из положения с.о. Отводила специальный столбец из обычных ячеек, в котором вводилось столько переводов строки, сколько строк информации должно появиться в соответствующей объединенной ячейке, тогда при включенном режиме "автоподбор высоты" строка раздвигается на ту высоту, которая определяется количеством символов перевода.
В моем случае использовать какую-либо ячейку нельзя: теоретичеески я должен предполагать, что все остальные ячейки уже содержат данные пользователя и "забивать" их своим текстом не допустимо. Поступил немного иначе: снял объединение, увеличил Width ячейки с данными до размеров исходной объединенной, применил автоподбор высоты, измерил высоту, потом все вернул на место и применил измеренную высоту к объедененной ячейке - дурацкий, конечно, способ... Надо как-то подумать на досуге о другом решении...
1. Получить Width ячейки получается, а вот установить - нет. Выскакивает ошибка 1004увеличил Width ячейки с данными до размеров исходной объединенной
2. Метод ColumnWidth работает не совсем корректно. Если с помощью ColumnWidth установить ширину у одного столбца как сумма ширин у объединённой ячейки, то реальная получившаяся ширина будет немного меньше, чем у объединённой ячейки.
Как всё-таки делать?
Windows 98, Office 97
tolikt,
1. про Width и Height в справке написано "Read only". Это абсолютно логично: считать, например, высоту одной ячейки можно, а вот установить высоту для ОДНОЙ ячейки нельзя, можно лишь для всей строки (RowHeight).
2. тут дела обстоят "запутанно":
а. Width возвращает ширину в точках;
б. ColumnWidth возвращает/принимает ширину в символах стиля Normal;
в. Width и ColumnWidth отличаются ещё и на ширину отступов с каждой стороны внутри ячейки (при выводе в неё);
...
Ставлю эксперимент:
1. Установил ширину ColumnWidth = 1, получил (моё разрешение, мой размер шрифта) Width = 9,75;
2. Установил ширину ColumnWidth = 2, получил Width = 15,75;
3. Разумно предположить (удвоения по Width нет), что Width - не просто прямопропорционально ColumnWidth, а имеет какое-то смещение (возможно, из-за необходимости визуального оформления Экселем ячеек, если их ширина будет равна ColumnWidth, то рамка ячейки будет начинаться и заканчиваться на буквах текста (по ширине), Эксель делает отступы. Найдем их).
4. Получилось два уравненица: Width1 = 1*wchr0+отступы; Width2 = 2*wchr0+отступы, где Width1=9,75 Width2=15,75 wchr0 - ширина в точках символа с кодом 0 (см. справку по ColumnWidth) отступы - искомое!
5. Решаю, получаю: wchr0 = Width2-Width1 = 6 (точек на один символ), отступы = Width1 - wchr0 = 3,75
6. Теперь можно решать обратную задачу. Допустим, мне нужно, чтобы ширина колонки С была равна сумме "ширин" колонок А и В.
7. Опять уравненице: WidthA + WidthB = ?ColumnWidthC + отступы
8. Эти восемь шагов и есть алгоритм, реализованный здесЯ!
1. про Width и Height в справке написано "Read only". Это абсолютно логично: считать, например, высоту одной ячейки можно, а вот установить высоту для ОДНОЙ ячейки нельзя, можно лишь для всей строки (RowHeight).
2. тут дела обстоят "запутанно":
а. Width возвращает ширину в точках;
б. ColumnWidth возвращает/принимает ширину в символах стиля Normal;
в. Width и ColumnWidth отличаются ещё и на ширину отступов с каждой стороны внутри ячейки (при выводе в неё);
...
Ставлю эксперимент:
1. Установил ширину ColumnWidth = 1, получил (моё разрешение, мой размер шрифта) Width = 9,75;
2. Установил ширину ColumnWidth = 2, получил Width = 15,75;
3. Разумно предположить (удвоения по Width нет), что Width - не просто прямопропорционально ColumnWidth, а имеет какое-то смещение (возможно, из-за необходимости визуального оформления Экселем ячеек, если их ширина будет равна ColumnWidth, то рамка ячейки будет начинаться и заканчиваться на буквах текста (по ширине), Эксель делает отступы. Найдем их).
4. Получилось два уравненица: Width1 = 1*wchr0+отступы; Width2 = 2*wchr0+отступы, где Width1=9,75 Width2=15,75 wchr0 - ширина в точках символа с кодом 0 (см. справку по ColumnWidth) отступы - искомое!
5. Решаю, получаю: wchr0 = Width2-Width1 = 6 (точек на один символ), отступы = Width1 - wchr0 = 3,75
6. Теперь можно решать обратную задачу. Допустим, мне нужно, чтобы ширина колонки С была равна сумме "ширин" колонок А и В.
7. Опять уравненице: WidthA + WidthB = ?ColumnWidthC + отступы
8. Эти восемь шагов и есть алгоритм, реализованный здесЯ!
Что получилось у меня и чем пока пользуюсь. Описание кода, по возможности подробное, в самом коде.
Sub RowHeightFiting1()
' Объединённая ячейка должна быть активной!!!
Application.ScreenUpdating = False
Dim MyRanAdr As String
Dim MergeAreaTotalWidth, MergeAreaTotalHeight
Dim MergeAreaFirstCellColWidth, MergeAreaFirstCellColHeight
Dim SumCW, SumRH
Dim i As Integer
Dim NewRH
Dim dCW '
MyRanAdr = ActiveCell.MergeArea.Address 'адрес области с объединённой ячейкой
MergeAreaTotalWidth = Range(MyRanAdr).Width ' ширина всей объединённой ячейки в ед. пт
MergeAreaTotalHeight = Range(MyRanAdr).Height ' высота всей объединённой ячейки в ед. пт
MergeAreaFirstCellColWidth = Range(MyRanAdr).Cells(1, 1).EntireColumn.ColumnWidth ' ширина первого столбца в объединённой ячейке
MergeAreaFirstCellColHeight = Range(MyRanAdr).Cells(1, 1).EntireRow.RowHeight ' высота первой строки в объединённой ячейке
' подсчёт суммарной ширины объед. ячейки в единицах ColumnWidth
SumCW = 0
For i = 1 To Range(MyRanAdr).Columns.Count
SumCW = SumCW + Range(MyRanAdr).Columns(i).ColumnWidth
Next
' Установка ширины первого столбца равной суммарной ширины объед. ячейки плюс поправка
' Поправка состоит из количества как бы "убранных" столбцов, умноженной на корректировочный коэффициент
Range(MyRanAdr).Cells(1, 1).ColumnWidth = SumCW + (Range(MyRanAdr).Columns.Count - 1) / 1.2 ' 1.2=3.75 / 4.5
' корректировочный коэффициент возникает из-за "краёв" каждого столбца
'далее, при необходимости, максимально точная подгонка
dCW = 0.1 ' шаг изменения ширины столбца в единицах ColumnWidth при подгонке
sgndcw = Sgn(MergeAreaTotalWidth - Range(MyRanAdr).Cells(1, 1).Width)
SumCW = Range(MyRanAdr).Cells(1, 1).ColumnWidth
While sgndcw * (MergeAreaTotalWidth - Range(MyRanAdr).Cells(1, 1).Width) > 0
SumCW = SumCW + dCW * sgndcw
Range(MyRanAdr).Cells(1, 1).EntireColumn.ColumnWidth = SumCW
Wend
While MergeAreaTotalWidth - Range(MyRanAdr).Cells(1, 1).Width < 0
SumCW = SumCW - dCW
Range(MyRanAdr).Cells(1, 1).EntireColumn.ColumnWidth = SumCW
Wend
' хотя, вообще-то, обычно эта часть процедуры не нужна
' просто на случай, если поправка к ширине первого столбца вдруг окажется неверной. Напр., из-за того, что ширина стольца меняется дискретно с шагом 0.167, но не всегда.
' форматирование ячейки (устан. опции перенос текста и разобъединение ячейки)
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).EntireRow.RowHeight = NewRH - (MergeAreaTotalHeight - MergeAreaFirstCellColHeight)
' Если нужно выровнять высоту строк, то можно использовать что-нибудь типа
'Range(MyRanAdr).EntireRow.RowHeight = NewRH / Range(MyRanAdr).Rows.Count
' установка изначальной ширины первого столбца
Range(MyRanAdr).Cells(1, 1).EntireColumn.ColumnWidth = MergeAreaFirstCellColWidth
Application.ScreenUpdating = True
L: ' усё
i = MsgBox("Das ist Fantastisch!" & Chr(10) & "Stimt das?", vbYesNo)
If i = vbNo Then GoTo L
End Sub
Глюков пока не замечал, но и не фантазировал в способах проверки
Впрочем, при большом количестве узких (менее примерно 3 симв) столбцов, входящих в объединённую ячейку или находящемся в ней длинном (более 100-150 символов) тексте (например, xls-фактуры, вытянутые из Консультант-плюс) может происходить следующее:
1. Новая высота объединённой ячейки выставляется как бы чуть-чуть "с запасом", т.е. больше, чем надо. Особенно в печатном виде. Но это, похоже, проблема самого Excelя.
2. Точная подгонка занимает ОЧЕНЬ много времени (более секунды). Просто процедура (там, где блок с While и написано, что эта часть обычно не используется) написана "в лоб" и совершенно неоптимизирована. Оставляю эту часть желающим на доделку. Или доделаю потом сам.
ЗЫ: В хелпе Office 97 не говорится о ReadOnly метода Width... А наоборот, Read and set...
Но на новый Office менять не могу, ибо с новым Office у меня внедрённые в лист Excelя картинки на печати выходят просто рамками.
Sub RowHeightFiting1()
' Объединённая ячейка должна быть активной!!!
Application.ScreenUpdating = False
Dim MyRanAdr As String
Dim MergeAreaTotalWidth, MergeAreaTotalHeight
Dim MergeAreaFirstCellColWidth, MergeAreaFirstCellColHeight
Dim SumCW, SumRH
Dim i As Integer
Dim NewRH
Dim dCW '
MyRanAdr = ActiveCell.MergeArea.Address 'адрес области с объединённой ячейкой
MergeAreaTotalWidth = Range(MyRanAdr).Width ' ширина всей объединённой ячейки в ед. пт
MergeAreaTotalHeight = Range(MyRanAdr).Height ' высота всей объединённой ячейки в ед. пт
MergeAreaFirstCellColWidth = Range(MyRanAdr).Cells(1, 1).EntireColumn.ColumnWidth ' ширина первого столбца в объединённой ячейке
MergeAreaFirstCellColHeight = Range(MyRanAdr).Cells(1, 1).EntireRow.RowHeight ' высота первой строки в объединённой ячейке
' подсчёт суммарной ширины объед. ячейки в единицах ColumnWidth
SumCW = 0
For i = 1 To Range(MyRanAdr).Columns.Count
SumCW = SumCW + Range(MyRanAdr).Columns(i).ColumnWidth
Next
' Установка ширины первого столбца равной суммарной ширины объед. ячейки плюс поправка
' Поправка состоит из количества как бы "убранных" столбцов, умноженной на корректировочный коэффициент
Range(MyRanAdr).Cells(1, 1).ColumnWidth = SumCW + (Range(MyRanAdr).Columns.Count - 1) / 1.2 ' 1.2=3.75 / 4.5
' корректировочный коэффициент возникает из-за "краёв" каждого столбца
'далее, при необходимости, максимально точная подгонка
dCW = 0.1 ' шаг изменения ширины столбца в единицах ColumnWidth при подгонке
sgndcw = Sgn(MergeAreaTotalWidth - Range(MyRanAdr).Cells(1, 1).Width)
SumCW = Range(MyRanAdr).Cells(1, 1).ColumnWidth
While sgndcw * (MergeAreaTotalWidth - Range(MyRanAdr).Cells(1, 1).Width) > 0
SumCW = SumCW + dCW * sgndcw
Range(MyRanAdr).Cells(1, 1).EntireColumn.ColumnWidth = SumCW
Wend
While MergeAreaTotalWidth - Range(MyRanAdr).Cells(1, 1).Width < 0
SumCW = SumCW - dCW
Range(MyRanAdr).Cells(1, 1).EntireColumn.ColumnWidth = SumCW
Wend
' хотя, вообще-то, обычно эта часть процедуры не нужна
' просто на случай, если поправка к ширине первого столбца вдруг окажется неверной. Напр., из-за того, что ширина стольца меняется дискретно с шагом 0.167, но не всегда.
' форматирование ячейки (устан. опции перенос текста и разобъединение ячейки)
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).EntireRow.RowHeight = NewRH - (MergeAreaTotalHeight - MergeAreaFirstCellColHeight)
' Если нужно выровнять высоту строк, то можно использовать что-нибудь типа
'Range(MyRanAdr).EntireRow.RowHeight = NewRH / Range(MyRanAdr).Rows.Count
' установка изначальной ширины первого столбца
Range(MyRanAdr).Cells(1, 1).EntireColumn.ColumnWidth = MergeAreaFirstCellColWidth
Application.ScreenUpdating = True
L: ' усё
i = MsgBox("Das ist Fantastisch!" & Chr(10) & "Stimt das?", vbYesNo)
If i = vbNo Then GoTo L
End Sub
Глюков пока не замечал, но и не фантазировал в способах проверки
Впрочем, при большом количестве узких (менее примерно 3 симв) столбцов, входящих в объединённую ячейку или находящемся в ней длинном (более 100-150 символов) тексте (например, xls-фактуры, вытянутые из Консультант-плюс) может происходить следующее:
1. Новая высота объединённой ячейки выставляется как бы чуть-чуть "с запасом", т.е. больше, чем надо. Особенно в печатном виде. Но это, похоже, проблема самого Excelя.
2. Точная подгонка занимает ОЧЕНЬ много времени (более секунды). Просто процедура (там, где блок с While и написано, что эта часть обычно не используется) написана "в лоб" и совершенно неоптимизирована. Оставляю эту часть желающим на доделку. Или доделаю потом сам.
ЗЫ: В хелпе Office 97 не говорится о ReadOnly метода Width... А наоборот, Read and set...
Но на новый Office менять не могу, ибо с новым Office у меня внедрённые в лист Excelя картинки на печати выходят просто рамками.
tolikt, откуда появился корректировочный коэффициент 1.2? (3.75 - ширнина в пт символа с кодом 0?, что такое 4.75?)
Зачем вообще нужны коэффициенты и вот эти строчки:
[quote (c) tolikt]
' Установка ширины первого столбца равной суммарной ширины объед. ячейки плюс поправка
' Поправка состоит из количества как бы "убранных" столбцов, умноженной на корректировочный коэффициент
Range(MyRanAdr).Cells(1, 1).ColumnWidth = SumCW + (Range(MyRanAdr).Columns.Count - 1) / 1.2 ' 1.2=3.75 / 4.5
' корректировочный коэффициент возникает из-за "краёв" каждого столбца
[/quote]
Если удалить эти строчки (вернее, одну строку), то всё прекрасно работает, благодаря Вашей точной подгонке через while.
Частный вопрос можно? Чем не понравился вариант с решением уравнения? Ведет себя некорректно? Подбора там нет, там есть точное решение.
Зачем вообще нужны коэффициенты и вот эти строчки:
[quote (c) tolikt]
' Установка ширины первого столбца равной суммарной ширины объед. ячейки плюс поправка
' Поправка состоит из количества как бы "убранных" столбцов, умноженной на корректировочный коэффициент
Range(MyRanAdr).Cells(1, 1).ColumnWidth = SumCW + (Range(MyRanAdr).Columns.Count - 1) / 1.2 ' 1.2=3.75 / 4.5
' корректировочный коэффициент возникает из-за "краёв" каждого столбца
[/quote]
Если удалить эти строчки (вернее, одну строку), то всё прекрасно работает, благодаря Вашей точной подгонке через while.
Частный вопрос можно? Чем не понравился вариант с решением уравнения? Ведет себя некорректно? Подбора там нет, там есть точное решение.
Код ниже немного подкорректирован, а именно:
1. Уточнена формула расчёта ширины одного столбца (в символах), равной общей ширине объед. ячейки
2. Удалены не очень нужные процедуры (лишние расчёты, подгонка) в соотвествии с п.1 и из предположения, что общая ширина объед. ячейки больше 1 (симв).
3. Удалены комментарии и прочее
Sub RowHeightFiting2()
' Объединённая ячейка должна быть активной!!!
' Если неактивна, то нужно переменной MyRanAdr присвоить ПОЛНЫЙ АДРЕС ОБЛАСТИ объединённой ячейки
Application.ScreenUpdating = False
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 - 3.75) / 4.5 'установка ширины первого столбца объед. ячейки равной общей ширине объед. ячейки '''БЕЗ ПОДГОНКИ!!!
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
Range(MyRanAdr).Cells(1, 1).EntireRow.RowHeight = NewRH - (MergeAreaTotalHeight - MergeAreaFirstCellColHeight) ' для 1-й строки в объед.ячейке
'Range(MyRanAdr).EntireRow.RowHeight = NewRH / Range(MyRanAdr).Rows.Count 'для равной высоты всех строк в объед.ячейке
Application.ScreenUpdating = True
End Sub
Код проверен на условиях, описанных в предыдущем посте.
Код простой, пояснения не требует.
Кроме, пожалуй, строки с Range(MyRanAdr).Cells(1, 1).ColumnWidth = (Range(MyRanAdr).Width - 3.75) / 4.5
Здесь: 3.75 - размер "боковушек" (отступов по краям) у ячейки (ширина в пт); 4.5 - ширина в пт одного символа стиля Normal (т.е. единицы измерения методом ColumnWidth)
1. Уточнена формула расчёта ширины одного столбца (в символах), равной общей ширине объед. ячейки
2. Удалены не очень нужные процедуры (лишние расчёты, подгонка) в соотвествии с п.1 и из предположения, что общая ширина объед. ячейки больше 1 (симв).
3. Удалены комментарии и прочее
Sub RowHeightFiting2()
' Объединённая ячейка должна быть активной!!!
' Если неактивна, то нужно переменной MyRanAdr присвоить ПОЛНЫЙ АДРЕС ОБЛАСТИ объединённой ячейки
Application.ScreenUpdating = False
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 - 3.75) / 4.5 'установка ширины первого столбца объед. ячейки равной общей ширине объед. ячейки '''БЕЗ ПОДГОНКИ!!!
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
Range(MyRanAdr).Cells(1, 1).EntireRow.RowHeight = NewRH - (MergeAreaTotalHeight - MergeAreaFirstCellColHeight) ' для 1-й строки в объед.ячейке
'Range(MyRanAdr).EntireRow.RowHeight = NewRH / Range(MyRanAdr).Rows.Count 'для равной высоты всех строк в объед.ячейке
Application.ScreenUpdating = True
End Sub
Код проверен на условиях, описанных в предыдущем посте.
Код простой, пояснения не требует.
Кроме, пожалуй, строки с Range(MyRanAdr).Cells(1, 1).ColumnWidth = (Range(MyRanAdr).Width - 3.75) / 4.5
Здесь: 3.75 - размер "боковушек" (отступов по краям) у ячейки (ширина в пт); 4.5 - ширина в пт одного символа стиля Normal (т.е. единицы измерения методом ColumnWidth)
3.75 и 4.5 - это не константы. Для другого компьютера (или для Вашего, если кое-чего подкрутить, например, масштаб - количество точек на дюйм) нужны другие числа. Нет? Или вот ещё аргумент: 4.5 - ширина в пт одного символа стиля Normal, но шрифты могут быть разными. Нет? Я считаю, числа нужно "получать" :!: