Предсказание переноса текста в ячейке
Проблема: я использую VBA, чтобы заполнить ячейки MS Excel 2000 текстом. Столбец имеет фиксированную ширину (не следует изменять из-за разметки), а свойство wordwrap установлено в значение true, поэтому текст переносится на несколько строк, если он шире столбца. К сожалению, высота строки не всегда обновляется соответствующим образом. Мне нужен способ предсказать, будет ли текст переноситься на несколько строк, чтобы я мог "вручную" отрегулировать высоту.
Я хочу сделать что-то вроде этого:
range("A1").value = longText
range("A1").EntireRow.RowHeight = 14 * GetNrOfLines(range("A1"))
Как мне написать функцию GetNrOfLines?
Я не могу полагаться на количество символов, так как шрифт не моно-пробел. Иногда ячейки, в которые я пишу, объединяются с другими ячейками, поэтому Autofit не работает. Пожалуйста, помните, что я работаю в Excel 2000. Предложения?
4 ответа
К сожалению, я не нашел хорошего решения. Проблема возникает из-за ошибки в Excel 2000. Я не знаю, относится ли это также к более поздним версиям.
Проблема проявляется при объединении ячеек по горизонтали. Высота строки не может автоматически настраиваться, когда вы объединяете ячейки.
В следующем примере кода показана проблема
Dim r As Range
Set r = Sheet1.Range("B2")
Range(r, r(1, 2)).Merge
r.Value = ""
r.Value = "asdg lakj dsgl dfgjdfgj dgj dfgj dfgjdgjdfgjdfgjd"
r.WrapText = True
r.EntireRow.AutoFit
В этом случае r.EntireRow.AutoFit не будет учитывать, что текст занимает несколько строк, и регулирует высоту, как если бы это была одна строка текста.
У вас будет та же проблема, когда вы выполняете автоматическое автоопределение (двойной щелчок на регуляторе высоты строки на листе) для строки, которая объединяет ячейки и перенос слов.
Решение (как предложено Гэри МакГиллом) заключается в использовании несвязанного листа. Установите ширину столбца, чтобы она соответствовала полному объему слитых ячеек. Скопируйте текст, с тем же форматированием. Позвольте ячейке автоматически настраиваться и используйте значения этих ячеек.
Здесь следует упрощенный пример:
Public Sub test()
Dim widthInPoints As Double
Dim mergedCells As Range
Set mergedCells = Sheet1.Range("B2:C2")
widthInPoints = mergedCells.width
Dim testCell As Range
Set testCell = Sheet2.Range("A1")
testCell.EntireColumn.columnWidth = ConvertPointsToColumnWidth(widthInPoints, Sheet2.Range("A1"))
testCell.WrapText = True
testCell.Value = mergedCells.Value
'Text formating should be applied as well, if any'
testCell.EntireRow.AutoFit
mergedCells.EntireRow.rowHeight = testCell.rowHeight
End Sub
Private Function ConvertPointsToColumnWidth(widthInPoints As Double, standardCell As Range) As Variant
ConvertPointsToColumnWidth = (widthInPoints / standardCell.width) * standardCell.columnWidth
End Function
Я решил эту проблему, вставив фигуру в лист, добавив текст, получив высоту фигуры, а затем удалив фигуру.
Примерно так для офиса 2007+:
Set tShape = Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, someWidth, 0)
tShape.TextFrame.AutoSize = True
tShape.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
tShape.TextFrame.Characters.Text = myLongTextString
rowHeight = tShape.TextFrame2.TextRange.BoundHeight
tShape.Delete
Для ofice 2003- кажется, что работает следующее:
Set tShape = Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, someWidth, 0)
tShape.TextFrame.AutoSize = True
tShape.TextFrame.Characters.Text = myLongTextString
rowHeight = tShape.Height
tShape.Delete
Вы говорите, что AutoFit не будет работать, потому что ячейка иногда объединяется (я полагаю, с ячейкой выше или ниже).
Однако вы могли бы создать временный рабочий лист, скопировать содержимое и форматирование (ширину столбца, шрифт, размер и т. Д.) Ячейки туда, а затем использовать AutoFit, чтобы получить идеальную высоту строки? Затем снова удалите временную таблицу. (Если вы делаете много ячеек одновременно, то, очевидно, вы можете использовать для них временную рабочую таблицу, не создавая ее заново каждый раз).