1 / 1 / 0
Регистрация: 08.05.2011
Сообщений: 40
1

AutoFit объединённой ячейки. ColumnWidth и Columns(n).Width

17.09.2006, 04:24. Показов 14918. Ответов 7
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Тема тут не раз обсуждалась, но внятного решения так и не представлено.
Напомню проблему.
В некоторой ОБЪЕДИНЁННОЙ ячейке (ячейке, созданной объединением двух или более ячеек) с установленным свойством "переносить по словам" находится длинный текст. Если этот текст не входит весь в видимую часть ячейки, то расширить автоматически строку не получится, т.к. метод "Автоподбор высоты" (AutoFit) у данной ячейки не работает.
В форумах предлагалось следующий метод:
а) поместить необходимый текст в какую-нибудь одну ячейку
б) установить для неё ширину и формат текста как у объединённой ячейки
в) применить к новой ячейки "Автоподбор высоты" (AutoFit)
г) получившуюся высоту новой ячейки установить у объединённой ячейки.

В связи с этим возникают вопросы.
Свойство ColumnWidth даёт не совсем верную ширину ячеек в следующем смысле: если посчитать ширину объединённой ячейки как ширину столбцов, в которых она расположена и установить получившуюся ширину у простого одного столбца, то реальная ширина одного столбца будет немного меньше, чем реальная ширина столбцов объединённой ячейки. Реальную ширину даёт свойство Width. Но у меня получается с помощью Width (напр., Range("D:F").Width) только получить ширину столбцов. А установить ширину (напр., Range("A").Width=100) не получается, т.к. выскакивает ошибка 1004.
Всё-таки, у кого-нибудь есть чёткое решение данной проблемы? ОЧЕНЬ ЖЕЛАТЕЛЬНО в виде подробного описания, по пунктам, а не умничания типа "ищите где-то и обрящете что-то...".
Windows 98, Office 97
0
17.09.2006, 04:24
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
17.09.2006, 04:24
Ответы с готовыми решениями:

Вызов формы из объединенной ячейки
Здравствуйте, подскажите, пожалуйста как можно вызвать функции в объединенной ячейке, которые прописаны в исходном коде листа? If...

Переход объединенной ячейки на новую строку
Никогда не думал, что возникнут проблемы с Word, но суть проблемы такова: В документе имеется БОООльшая таблица на страниц 10-15, и есть...

Как получить значение объединенной ячейки Excel
Всем Доброго времени суток! Суть вопроса такова: Есть объединенная ячейка (R2C2). Нужно пройтись по всем строкам, входящие в эту ячейку,...

7
2 / 2 / 0
Регистрация: 16.04.2012
Сообщений: 24
21.09.2006, 03:41 2
а если поступить например так?

исходим из 3 положений:

1. ширина объедененной ячейки точно ровна ширине необедененных ячеек входящих в нее
2. столбец (без учета объеденения) имеет одинкаовую ширину по всей длинне
3. строка - например - последняя у нас не занята

на основе этого строим код:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
'стоим на объедененной ячейке
'считаем количество столбцов входящих в объедененную ячейку
a = ActiveCell.Offset(0, 1).Column - ActiveCell.Column
 
'по последней строке которая у нас не объеденена считаем сумму ширины ячеек
swidth = 0
For Each cell In Range(Cells(65536, ActiveCell.Column), Cells(65536, ActiveCell.Column + a - 1))
  swidth = swidth + cell.ColumnWidth
Next
'выдаем результат
MsgBox swidth
вот мы и получили точную ширину объедененной ячейки - кажется в этом была основная проблема - остальные дейтсвия уже описаны и в коде вроде не нуждаются...

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

ответил - а потом подумал... возможно в E97 нет всех тех объектов и свойств которые применились... хотя маловероятно...
0
1 / 1 / 0
Регистрация: 08.05.2011
Сообщений: 40
27.09.2006, 18:29  [ТС] 3
Вначале отвечу на предыдущий ответ игория, потом следущим сообщением - своё решение.
1. ширина объедененной ячейки точно ровна ширине необедененных ячеек входящих в нее
Да, но только если ширину получить методом Width. А ColumnWidth даёт не совсем верную ширину, о чём и был вопрос в первом посте. А так как далее у игория
swidth = 0
For Each cell In Range(Cells(65536, ActiveCell.Column), Cells(65536, ActiveCell.Column + a - 1))
swidth = swidth + cell.ColumnWidth
Next
'выдаем результат
MsgBox swidth
вот мы и получили точную ширину объедененной ячейки - кажется в этом была основная проблема
то ясно, что ответ не по сути первого сообщения. А уж использовать какую-то конструкцию, в которой фигурирует последняя строка
Range(Cells(65536, ActiveCell.Column),
- можно, но, думаю, совершенно излишне.
А по поводу
возможно в E97 нет всех тех объектов и свойств которые применились... хотя маловероятно...
то тут игорий абсолютно прав по сути: в коде лучше использовать простые объекты и свойства которые есть даже в Office 97.
0
2 / 2 / 0
Регистрация: 16.04.2012
Сообщений: 24
27.09.2006, 20:13 4
вам шашечки или ехать?
если шашечки, то:
свойство width объекта range имеет формат readonly - отсюда и вылетающая ошибка
свойство width как и свойство columnwidth описывают одно и то же, но в разных единицах - поэтому говорить о том что свойство columnwidth вам не очень подходит потому чтоне точное... - оно не менее точное чем width
а если ехать, то:
ширина объедененной ячейки точно ровна ширине необедененных ячеек входящих в нее независимо от единиц измерения и применяемых методов или свойств

к постам ниже: да, я ошибся.
0
1 / 1 / 0
Регистрация: 08.05.2011
Сообщений: 40
27.09.2006, 21:15  [ТС] 5
игорию.
1. Выдели столбцы A:E
2. Установи ширину каждого равной 5
3. Установи ширину столбца F равной 25 (т.е. как сумму ширин пяти предыдущих)
4. У строки 1 установи:
- шрифт: Arial, обычный, 11 пт
- выравнивание: переносить по словам
5. Объедини ячейки A1:E1
6. В объединённую ячейку внеси текст "Ну, игорий, ты юморист!"
7. В ячейку F1 также внеси текст "Ну, игорий, ты юморист!"
Если всё правильно сделал, то текст в ячейке F1 не входит в одну строку, а в объединённой ячейке - входит.Вот код, который всё сделает сам.
В конце его выполнения показывается истинная ширина ячеек. Т. е. Width.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub ExampleFor_игорий()
ActiveWindow.Zoom = 100
    Columns("A:E").Select
    Selection.ColumnWidth = 5
    Columns("F:F").Select
    Selection.ColumnWidth = 25
    
    Rows("1:1").Select
        With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
    End With
    Range("A1:E1").Select
    Selection.Merge
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Ну, игорий, ты юморист!"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Ну, игорий, ты юморист!"
    
MsgBox "Ширина объед.ячейки A1:E1 - " & Cells(1, 1).MergeArea.Width & _
Chr(10) & "Ширина простой ячейки F1  -  " & Cells(1, 6).Width
End Sub
0
1 / 1 / 0
Регистрация: 08.05.2011
Сообщений: 40
27.09.2006, 21:18  [ТС] 6
Что получилось у меня и чем пока пользуюсь. Описание кода, по возможности подробное, в самом коде.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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
[b] Глюков пока не замечал, но и не фантазировал в способах
0
1 / 1 / 0
Регистрация: 08.05.2011
Сообщений: 40
28.09.2006, 21:38  [ТС] 7
Код ниже немного подкорректирован, а именно:
1. Уточнена формула расчёта ширины одного столбца (в символах), равной общей ширине объед. ячейки
2. Удалены не очень нужные процедуры (лишние расчёты, подгонка) в соотвествии с п.1 и из предположения, что общая ширина объед. ячейки больше 1 (симв).
3. Удалены комментарии и прочее
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub RowHeightFiting2()
' Объединённая ячейка должна быть активной!!! <FONT color=#dd33dd>' Если неактивна, то нужно переменной 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
Код проверен на условиях, описанных в предыдущем посте. (Случайно обнаружил, что нельзя установить высоту строки более 409.50)
Код простой, пояснения не требует. Кроме, пожалуй, строки с Range(MyRanAdr).Cells(1, 1).ColumnWidth = (Range(MyRanAdr).Width - 3.75) / 4.5. Здесь: 3.75 - размер "боковушек" (отступов по краям) у ячейки (ширина в пт); 4.5 - ширина в пт одного символа стиля Normal (т.е. единицы измерения методом ColumnWidth)
0
1 / 1 / 0
Регистрация: 08.05.2011
Сообщений: 40
29.09.2006, 18:21  [ТС] 8
Мой предыдущий ответ с подкорректированным кодом имеет очень жуткий недостаток. Он работает только с тем стилем Normal, для которого рассчитаны коэффициенты ширин символа и краёв столбца.
Здесь: 3.75 - размер "боковушек" (отступов по краям) у ячейки (ширина в пт); 4.5 - ширина в пт одного символа стиля Normal (т.е. единицы измерения методом ColumnWidth)
В данном случае Times New Roman Cyr 10пт. И если невнимательно прочитать два предыдущих поста, а сразу воспользоваться кодом, то на других стилях Normal возможно неверное выполнение кода. И про эту особенность я забыл упомянуть.
Теперь исправляю.
Сначала отдельно выкладываю код MiddEdgeWidth с комментариями. Он определяет ширину в пт середины и краёв для стиля Normal в активной рабочей книге.
А после - RowHeightFiting3 - итоговый код подгонки высоты объединённой ячейки с учётом текущего стиля Normal.
Код:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
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
высоту строки за минусом разницы между первоначальной высотой ячейки и высотой пустой ячейки.
Т.к. необходимость этой манипуляции зависит от желания пользователя, то в данном коде эта процедура не отражена!

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

Вроде, понятно объяснил....
1
29.09.2006, 18:21
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
29.09.2006, 18:21
Помогаю со студенческими работами здесь

Разбираем макрос автоподбора высоты строк в объединённой ячейки
Уважаемые КиберФорумчане, нашёл в сети хороший рабочий пример макроса по автоподбору высоты строки объединённой ячейки, и вроде всё...

функция ВПР как добавить значение из объединенной ячейки
Возникла такая проблемка: с функцией ВПР все значения, которые нужны возвращает, а вот если две строки объединены там написано ФИО, а в...

Установка DBGrid columns при выводе через запрос SQLquery (обычный вывод в editing DBGrid Columns все настраивается)
procedure TForm1.Button33Click(Sender: TObject); //Кнопка Все вывести begin sqlquery2.Active:=FALSE; ...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
8
Ответ Создать тему

Редактор формул (кликните на картинку в правом углу, чтобы закрыть)
Опции темы

Новые блоги и статьи
Ошибка "Cleartext HTTP traffic not permitted" в Android
hw_wired 13.02.2025
При разработке Android-приложений можно столнуться с неприятной ошибкой "Cleartext HTTP traffic not permitted", которая может серьезно затруднить отладку и тестирование. Эта проблема особенно. . .
Изменение версии по умолчанию в NVM
hw_wired 13.02.2025
Node Version Manager, или коротко NVM - незаменимый инструмент для разработчиков, использующих Node. js. Многие сталкивались с ситуацией, когда разные проекты требуют различных версий Node. js,. . .
Переименование коммита в Git (локального и удаленного)
hw_wired 13.02.2025
Git как система контроля версий предоставляет разработчикам множество средств для управления этой историей, и одним из таких важных средств является возможность изменения сообщений коммитов. Но зачем. . .
Отличия Promise и Observable в Angular
hw_wired 13.02.2025
В веб-разработки асинхронные операции стали неотъемлимой частью почти каждого приложения. Ведь согласитесь, было бы странно, если бы при каждом запросе к серверу или при обработке больших объемов. . .
Сравнение NPM, Gulp, Webpack, Bower, Grunt и Browserify
hw_wired 13.02.2025
В современной веб-разработке существует множество средств сборки и управления зависимостями проектов, каждое из которых решает определенные задачи и имеет свои особенности. Когда я начинаю новый. . .
Отличия AddTransient, AddScoped и AddSingleton в ASP.Net Core DI
hw_wired 13.02.2025
В современной разработке веб-приложений на платформе ASP. NET Core правильное управление зависимостями играет ключевую роль в создании надежного и производительного кода. Фреймворк предоставляет три. . .
Отличия между venv, pyenv, pyvenv, virtualenv, pipenv, conda, virtualenvwrapp­­er, poetry и другими в Python
hw_wired 13.02.2025
В Python существует множество средств для управления зависимостями и виртуальными окружениями, что порой вызывает замешательство даже у опытных разработчиков. Каждый инструмент создавался для решения. . .
Навигация с помощью React Router
hw_wired 13.02.2025
React Router - это наиболее распространенное средство для создания навигации в React-приложениях, без которого сложно представить современную веб-разработку. Когда мы разрабатываем сложное. . .
Ошибка "error:0308010C­­:dig­ital envelope routines::unsup­­ported"
hw_wired 13.02.2025
Если вы сталкиваетесь с ошибкой "error:0308010C:digital envelope routines::unsupported" при разработке Node. js приложений, то наверняка уже успели поломать голову над её решением. Эта коварная ошибка. . .
Подключение к контейнеру Docker и работа с его содержимым
hw_wired 13.02.2025
В мире современной разработки контейнеры Docker изменили подход к созданию, развертыванию и масштабированию приложений. Эта технология позволяет упаковать приложение со всеми его зависимостями в. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2025, CyberForum.ru