预测单元格中的文本换行

Question

问题： 我使用 VBA 用文本填充 MS Excel 2000 单元格。该列具有固定宽度（不应因布局而更改），并且 wordwrap 属性设置为 true，因此如果比列宽，文本将换行多行。 不幸的是，行高并不总是相应更新。我需要一种方法来预测文本是否会换行多行，以便我可以“手动”调整高度。

我想做这样的事情：

range("A1").value = longText  
range("A1").EntireRow.RowHeight = 14 * GetNrOfLines(range("A1"))  

如何编写函数 GetNrOfLines？

我不能依赖字符数，因为字体不是等宽字体。有时，我正在写入的单元格会与其他单元格合并，因此自动调整不起作用。 请记住，我使用的是 Excel 2000。 建议？

Answer 1

您说自动调整不起作用，因为单元格有时会合并（我认为与上方或下方的单元格合并）。

但是，您可以创建一个临时工作表，复制那里单元格的内容和格式（列宽、字体、大小等），然后使用自动调整来获得理想的行高？
然后再次删除临时工作表。 （如果您一次处理大量单元格，那么显然您可以为所有单元格使用临时工作表，而无需每次都重新创建它）。

Answer 2

不幸的是，我还没有找到好的解决方案。
该问题源于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 将不会考虑文本跨越多行，并像单行文本一样调整高度。
当对已合并单元格和自动换行的行进行手动自动调整（双击工作表中的行高调整器）时，您也会遇到同样的问题。

一个解决方案（如 Gary McGill 建议）是使用不相关的工作表。设置列宽以匹配合并单元格的完整宽度。复制文本，格式相同。让单元格自动调整并使用该单元格值。

下面是一个简化的示例：

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

Answer 3

使用 Range.Rows.AutoFit 方法怎么样？

Answer 4

我通过在工作表中插入形状、添加文本、获取形状的高度，然后删除形状来解决此问题。

对于 Office 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

对于 Office 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