Предсказание переноса текста в ячейке

Проблема: я использую 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

Как насчет использования Range.Rows.AutoFit метод?

Я решил эту проблему, вставив фигуру в лист, добавив текст, получив высоту фигуры, а затем удалив фигуру.

Примерно так для офиса 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, чтобы получить идеальную высоту строки? Затем снова удалите временную таблицу. (Если вы делаете много ячеек одновременно, то, очевидно, вы можете использовать для них временную рабочую таблицу, не создавая ее заново каждый раз).

Другие вопросы по тегам